Hallo Notesianer,
ich habe hier eine Problem mit einem Agenten, welcher unter Windows 32-Bit ohne Probleme funktioniert, aber unter 64-Bit einfach nichts macht, auch keine Fehlermeldung anzeigt.
Der Agent speichert eine E-Mail in einer Projektverwaltung auf einer AS/400.
Hier der Agent:
Option Public
Uselsx "*lsxodbc"
Sub Initialize
Dim s As NotesSession
Dim db As NotesDatabase
Dim coll As NotesDocumentCollection
Dim doc As NotesDocument
Dim iBody As NotesRichTextItem
Dim iWer As NotesItem
Dim iBetreff As NotesItem
Dim iDelivered As NotesItem
Dim attobject As Variant
Dim xlatTable As String
Dim baoticket As String
Dim baower As String
Dim baobez As String
Dim baobezkz As String
Dim body As String
Dim wer As String
Dim betreff As String
Set s = New notessession
Set db = s.currentDatabase
Set coll = db.UnprocessedDocuments
If Not coll Is Nothing Then
If coll.Count > 0 Then
For i = 1 To coll.count
Set doc = coll.GetNthDocument(i)
' Betreff suchen
Set iBetreff = doc.GetFirstItem("Subject")
Betreff = Cstr(iBetreff.Text)
' Absender suchen
Set iWer = doc.GetFirstItem("From")
wer = iWer.Text
' Mail Text suchen
Set iBody = doc.GetFirstItem("Body")
body = Cstr(iBody.GetFormattedText(True, 71))
If (Instr(1, body, "mit freund",5) <> 0) Then
body = Left(body, Instr(1, body, "mit freund", 5)-1)
End If
If (Instr(1, body, "mfg",5) <> 0) Then
body = Left(body, Instr(1, body, "mfg", 5)-1)
End If
' Anfe anlegen
Dim con As New ODBCConnection
Dim qry As New ODBCQuery
Dim res As New ODBCResultset
Dim prnr As Long
Dim kdnr As Long
Dim penr As Long
Set qry.Connection = con
Set res.Query = qry
If (con.ConnectTo("projekt","", "")) Then
' Neue Nummer vergeben
qry.SQL="Select max(prnr) as prnr from prjdta.sofprjpu where prfir = '001' and pranwg = 'WWN' and prnr > 80000"
res.Execute
res.FirstRow
prnr = Clng(res.GetValue("PRNR"))
If prnr = 0 Then
prnr =80000
End If
prnr = prnr + 1
res.close
' Kundennummer suchen
Dim werdom As String
Dim werwer As String
Dim mailadr As NotesName
Set mailadr = s.CreateName(wer)
wer = mailadr.Addr821
werdom = wer
werwer = wer
If (Instr(1, wer, "@",5) <> 0) Then
werdom = Mid$(wer, Instr(1, wer, "@", 5)+1)
werwer = Left$(wer, Instr(1, wer, "@", 5)-1)
' qry.SQL="Select txky02 as kdnr from prjdta.ptftxtp where txfir = '001' and txfil = ' ' and txky01 = 'KDN' and txtx78 like '%"+Trim(werdom)+"%'"
qry.SQL="Select aaky01 as kdnr, aaname, aaname2 from prjdta.wadrapu where aafir = '001' and aainfa = 'KDANS' and upper(aaemail concat aamodem) like '%"+Trim(Ucase(werwer))+"%'"
res.Execute
res.FirstRow
If res.GetError = DBstsSUCCESS Then
kdnr = Clng(Trim(res.GetValue("KDNR")))
werwer = Trim(res.GetValue("AANAME"))+" "+res.GetValue("AANAME2")
Else
qry.SQL="Select aaky01 as kdnr from prjdta.wadrapu where aafir = '001' and aainfa = 'KDANS' and upper(aaemail concat aamodem) like '%"+Trim(Ucase(werdom))+"%'"
res.Execute
res.FirstRow
If res.GetError = DBstsSUCCESS Then
kdnr = Clng(Trim(res.GetValue("KDNR")))
Else
kdnr = 36000
End If
End If
Else
kdnr =36000
End If
If kdnr = 0 Then
kdnr =36000
End If
res.close
' Personalnummer suchen
qry.SQL="Select inkey as penr from prjbto.binfopu where infir = '001' and ininfa = '100' and ininfo like '%"+Trim(s.CommonUserName)+"%'"
res.Execute
res.FirstRow
penr = Clng(res.GetValue("PENR"))
If penr = 0 Then
penr =11
End If
res.close
' Satz in Prjektverwaltung anlegen
qry.sql="insert into prjdta.sofprjpu values('001',"+Cstr(kdnr)+", 'WWN',"+Cstr(prnr)+", 'S', 0, ' ', ' ', "+Cstr(penr)+", CURRENT DATE, 'B', '"+Cstr(Left$(betreff, 76))+"', ' ', 'E', '"+Trim(werwer)+"', ' ', "+Cstr(penr)+", '01', 0, '01.01.0001', '01.01.0001', 0, '01.01.0001', ' ', 0, ' ', 0, 0, 0, 0, 0, 0, 0, ' ', 0, 0, ' ', 0, 0, ' ', 0, 0, ' ', 0, 0, ' ', 0, 0, ' ', 0, 0, ' ', 0, '01.01.0001', 0, 0, CURRENT TIMESTAMP, CURRENT TIMESTAMP, ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)"
res.Execute
res.Close
' Texte in Projektverwaltung schreiben
Dim text As String
Dim textsav As String
start = 1
lfd = 1
' Set iDelivered = doc.GetFirstItem("DeliveredDate")
Set iDelivered = doc.GetFirstItem("PostedDate")
text = "Original Mail von " & werwer & " vom " & Cstr(iDelivered.Text)
qry.SQL="insert into prjdta.sofprtpu values('001',"+Cstr(prnr)+", 'HL',"+Cstr(lfd)+", '"+text+"', "+Cstr(penr)+", CURRENT DATE)"
res.Execute
res.Close
lfd = 2
textsav = " "
baobezkz = "0"
While start < Len(Trim(body))
k = Instr(start,body,Chr$(13)&Chr$(10))
If (k = 0 Or (k - start)>71) Then
text = Mid(body, start, 71)
start = start + 71
Else
text = Mid(body, start, k-start)
start = k + 2
End If
If baobezkz = "1" Then
baobez = text
baobezkz = "0"
End If
k = Instr(1,text,"Ticket Nr.:")
If k <> 0 Then
baoticket = Mid(text, k+11, start-1)
End If
k = Instr(1,text,"Anlage:")
If k <> 0 Then
baower = Mid(text, k+11, start-1)
End If
k = Instr(1,text,"Beschreibung:")
If k <> 0 Then
baobezkz = "1"
End If
If Rtrim(Ltrim(text)) <> Rtrim(Ltrim(textsav)) Then
qry.SQL="insert into prjdta.sofprtpu values('001',"+Cstr(prnr)+", 'HL',"+Cstr(lfd)+", '"+text+"',"+Cstr(penr)+", CURRENT DATE)"
End If
res.Execute
res.Close
textsav = text
lfd = lfd + 1
Wend
' Anhang Verzeichnis suchen
anhangdir = "C:\"
Open "C:\PROJEKT\SYSTEM\PROJEKT.INI" For Input As #1
Do Until Eof(1)
Line Input #1, iniline
If (Instr(1, iniline, "ANHANGDIR=") <> 0) Then
anhangdir = Mid$(iniline, 11)
End If
Loop
Close #1
If Mid$(anhangdir, Len(Rtrim(anhangdir)), 1) <> "\" Then
anhangdir = Rtrim(anhangdir) & "\"
End If
anhangdir = Rtrim(anhangdir) & prnr
Mkdir anhangdir
' Anhänge speichern
Forall idoc In doc.items
If idoc.type = Attachment Then
Set attobject = doc.GetAttachment( idoc.values(0) )
Call attobject.ExtractFile(anhangdir & "\" & attobject.source)
End If
End Forall
'Anpassung wegen Kunde
' If kdnr = 11004 Then '
' qry.sql="update prjdta.sofprjpu set prkdref = '"+Rtrim(Ltrim(baoticket))+"' where prnr= "+Cstr(prnr)
' res.Execute
' res.Close
' qry.sql="update prjdta.sofprjpu set pransp = '"+Rtrim(Ltrim(baower))+"' where prnr= "+Cstr(prnr)
' res.Execute
' res.Close
' qry.sql="update prjdta.sofprjpu set prbezei = '"+Rtrim(Ltrim(baobez))+"' where prnr= "+Cstr(prnr)
' res.Execute
' res.Close
' End If
Call con.Disconnect
Msgbox("Ihre E-Mail wurde als Internenummer " & prnr & " in der Projektverwaltung übernommen.")
End If
Next
End If
End If
End Sub
----- Schnapp
Was läuft schief?