Hallo,
Uselsx "*LSXODBC" mußt Du im Deklatationsbereich eingeben
Hier ein Beispiel von mir
ich gehe auf Daten von AS400; aber Syntax ist diesselbe(sql...)
es gibt auch die Möglichkeit von NOtes auf die DBEngine von Access zu gehen; da kannst Du besser und direkt mit den Daten spielen
kann ich Dir auch schicken sofern gebraucht
Grüße, Pippo
*****************
Dim con As New ODBCConnection
Dim qry As New ODBCQuery
Dim result As New ODBCResultSet
Dim Rec As Long, txt As String
Dim fileNum As Integer
Set qry.Connection = con
Set result.Query = qry
con.ConnectTo "ODBCAS400PREISOS", "HITODBC_OS" , "HITODBC_OS"
REM Bestimmen Artikel suchen
Dim Sql As String, SqlTab1 As String
Dim Libreria As String
Dim GespANPRO00F As Integer, GespANPRA00F As Integer
GespANPRO00F = 0
GespANPRA00F = 0
REM Achtung !!! Hier die Libreria eintragen
Libreria="DATENRV"
REM TestLibreria
REM Libreria="AVWRISDIV"
REM Tabelle 1. wird gespeichert, sofern Flag auf ja
If doc.TAB1FLAG(0) = "10" Then
Print "Daten von Tabelle 1 werden gelesen"
SqlTab1 = "SELECT ANPRO00F.A§COAR, ANPRO00F.A§STAT, ANPRO00F.A§PREZ, ANPRO00F.A§PREA, ANPRO00F.A§DTLA, ANPRO00F.A§DTCA, ANPRO00F.A§PRZP, ANPRO00F.A§DTLP, ANPRO00F.A§PREP, ANPRO00F.A§DTCP, ANPRO00F.A§DEAR"
SqlTab1 = SqlTab1 & " FROM " & Libreria & ".ANPRO00F"
SqlTab1 = SqlTab1 & " WHERE (ANPRO00F.A§STAT=' ' and ANPRO00F.A§COAR='" & doc.COAR(0) & "')"
qry.SQL = SqlTab1
result.Execute
Dim tmpDT
Rec = 0
If result.IsResultSetAvailable Then
Do
result.NextRow
Rec = Rec +1
REM Kontrolle Anzahl
If Rec > 1 Then
Msgbox "Fataler Fehler: Artikel in AS400 " & Rec & " mal vorhanden!", 48, "Raiffeisen"
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
REM Kontrolle Readonly
If result.ReadOnly = True Then
Msgbox "Sie sind nicht berechtigt die Daten auf AS400 zu bearbeiten!", 48, "Raiffeisen"
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
If Not result.IsEndOfData Then
Msgbox "Fataler Fehler! mehr als ein Record gefunden!"
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
REM Artikelnummer
Dim COAR
Call result.GetValue("A§COAR", COAR)
REM Kontrolle
If Trim(doc.COAR(0)) <> COAR Then
Msgbox "Fataler Fehler! Gesuchter Artikelcode und gefundener Code sind verschieden!", 48, "Raiffeisen"
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
REM Aktuelle Preise werden in Feldern von alten Preisen geschrieben
REM Einkaufspreis
Dim PREA
Call result.GetValue("A§PREA", PREA)
REM DATUM
Dim DTCA As String
Call result.GetValue("A§DTCA", DTCA)
REM Verkaufspreis
Dim PREZ
Call result.GetValue("A§PREZ", PREZ)
REM DATUM
Dim DTLA As String
Call result.GetValue("A§DTLA", DTLA)
Loop Until result.IsEndOfData
Else
Msgbox "Artikel auf AS400 nicht gefunden!", 48, "Raiffeisen"
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
result.Close(DB_CLOSE)
REM Neue Preise werden geschrieben
REM Sofern Speichern aktiviert ist
REM DATUM Aktueller Preis
Dim tmpDatum As String
tmpDatum = Format(Now,"yyyymmdd")
If Len (tmpDatum) <> 8 Then
Msgbox "Fehler bei Datum - verschieden 8 Zeichen - " & tmpDatum
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
REM Nun wird auf AS400 direkt über Udate die Aktualisierung vorgenommen
Print "Tabelle 1 wird aktualisiert"
REM Aktuelle Werte in alte Werte schreiben
sql = "UPDATE S44B3786." & Libreria & ".ANPRO00F SET A§PREP=" & DezInPunkt( PREA, RWert) & ", A§PRZP=" & DezInPunkt(PREZ, RWert) & ", A§DTLP=" & Clng(DTLA) & ", A§DTCP=" & Clng(DTCA)
REM Neue Werte Schreiben
sql = sql & ", A§PREZ=" & DezInPunkt( doc.PREZ(0), RWert) & ", A§PREA=" & DezInPunkt( doc.PREA(0), RWert) & ", A§DTCA=" & Clng(tmpDatum) & ", A§DTLA=" & Clng(tmpDatum)
sql = sql & " WHERE A§COAR = '" & doc.COAR(0) & "'"
REM Kontrolle, sofern umwandlung von dez in punkt nicht erfolgreich
If RWert <> 0 Then
Msgbox "Speichern wird nicht ausgeführt!!!", 48, "Raiffeisen"
Exit Sub
End If
qry.SQL = sql
result.Execute
GespANPRO00F=1
REM Daten werden Neu gelesen
Print "Daten von Tabelle 1 werden neu gelesen"
qry.SQL = SqlTab1
result.Execute
Rec = 0
If result.IsResultSetAvailable Then
Do
result.NextRow
Rec = Rec +1
REM Kontrolle Anzahl
If Rec > 1 Then
Msgbox "Fataler Fehler: Artikel in AS400 " & Rec & " mal vorhanden!", 48, "Raiffeisen"
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
Loop Until result.IsEndOfData
Else
Msgbox "Artikel auf AS400 nicht gefunden!", 48, "Raiffeisen"
result.Close(DB_CLOSE)
con.Disconnect
Print ""
Exit Sub
End If
REM Felder auf Null; verwende diese methode, damit nicht alles neu gesucht werden muß
Dim tmpCOAR As String, tmpNOTL As String
REM diese 2 Felder werden für die 2. Tabelle zwischengespeichert
tmpCOAR = doc.COAR(0)
tmpNOTL = doc.NOTL(0)
Print "Felder werden geleert"
Call FelderNull(doc)
REM Artikelnummer
REM Nach dem Löschen aller Felder werden diese 2 wiederum geschrieben
doc.COAR = tmpCOAR
doc.NOTL = tmpNOTL
REM Felder von 1. Tabelle
Print "Daten von Tabelle 1 werden in Felder geschrieben"
Call writeTab_1(result , doc )
result.Close(DB_CLOSE)
End If
REM Beginn von Tabelle 2
Print "Daten von NOTE werden geschrieben"
If doc.NOTLFLAG(0) = "10" Then
REM Nun wird auf AS400 direkt über Udate die Aktualisierung vorgenommen
sql = "UPDATE S44B3786." & Libreria & ".ANPRA00F SET AJNOTL='" & Trim(doc.NOTL(0)) & "'"
sql = sql & " WHERE AJCOAR = '" & doc.COAR(0) & "'"
qry.SQL = sql
result.Execute
GespANPRA00F = 1
End If
Print "Daten von NOTE werden gelesen"
sql = "SELECT ANPRA00F.AJCOAR, ANPRA00F.AJNOTL"
sql = sql & " FROM " & Libreria & ".ANPRA00F"
sql = sql & " WHERE (ANPRA00F.AJCOAR='" & doc.COAR(0) & "')"
qry.SQL = sql
result.Execute
Rec = 0
If result.IsResultSetAvailable Then
Do
Rec = Rec +1
result.NextRow
If Rec > 1 Then
Msgbox "Fataler Fehler! mehr als ein Record gefunden!"
Print ""
End If
REM Kontrolle Readonly
If result.ReadOnly = True Then
Msgbox "Sie sind nicht berechtigt die Daten auf AS400 zu bearbeiten!", 48, "Raiffeisen"
Print ""
Exit Sub
End If
If Not result.IsEndOfData Then
Msgbox "Fataler Fehler! mehr als ein Record gefunden!"
Print ""
Exit Sub
End If
Loop Until result.IsEndOfData
End If
REM Felder von 2. Tabelle
Call writeTab_2(result , doc )
result.Close(DB_CLOSE)
REM Flag immer auf NULL
doc.NOTLFLAG = ""
Print ""
con.Disconnect
If GespANPRO00F = 1 And (doc.NOTLFLAG(0) = "" Or (doc.NOTLFLAG(0) = "10" And GespANPRA00F = 1))Then
Msgbox "Daten wurden auf AS400 erfolgreich aktualisiert!", 48, "Raiffeisen"
End If
Exit Sub
errorHandler:
If con.GetError <> DBstsSuccess Then
con.Disconnect
Msgbox con.GetError & " - " & con.GetErrorMessage & " - " & con.GetExtendedErrorMessage,, "Connect"
Elseif qry.GetError <> DBstsSuccess Then
con.Disconnect
Msgbox qry.GetError & " - " & qry.GetErrorMessage & " - " & con.GetExtendedErrorMessage,, "Query"
Elseif result.GetError <> DBstsSuccess Then
result.Close(DB_CLOSE)
con.Disconnect
Msgbox result.GetError & " - " & result.GetErrorMessage & " - " & con.GetExtendedErrorMessage,, "Result - " & PREA & " - " & PREZ
Else
Msgbox "Fehler: " & Err & " - " & Error
End If
Exit Sub
