LSX Transfer Code and Troubleshooting Hints

I don't know if its proper to attach code here, but I pasted the code for the agent here just in case some other novice LotusScript programmer is trying to do the same thing. This code would have saved me 3+ days of work....

Option Public
'-specify ODBC connector class. Can't run from client unless set up, can only run
' on server using log to see what's happenning
Uselsx "*lsxodbc"

Sub Initialize
'--------------------------CC Customer Contacts transfer-----------------------

'-catch all errors not monitored for at specific statements
On Error Goto Handler

' -Declare statements for Notes Session and document creation
Dim Session As New NotesSession
Dim db As NotesDatabase
Dim newDoc As NotesDocument
Dim ViewDoc As NotesDocument, NextDoc As NotesDocument
Dim View As NotesView
Set db = Session.CurrentDatabase

'-Misc variables

Dim countfetch As Integer, countdel As Integer, countadd As Integer
Dim countupd As Integer
Dim ischg As Variant
Dim NowDate As String
NowDate = Date$

'-Create list to store Notes document ids that were added or checked for update and shouldn't be deleted

Dim docidlist List As String

'-Define Log document

Dim logbody As String
Dim logDb As NotesDatabase
Dim logDoc As NotesDocument
Set logDb = Session.GetDataBase("AS400/myserver", "IS/AgentLog.nsf",False)
Set logDoc = New NotesDocument( logDb )
logDoc.Server = "Agent"
logDoc.Form = "Activity"
logDoc.StartTime = Now

'-Define ODBC usage. Open Connection to AS/400

Dim con As New ODBCConnection
Dim qry As New ODBCQuery
Dim fields As New ODBCResultSet
Set qry.Connection = con
Set fields.Query = qry
Call con.ConnectTo("S10mysysid", "NOTESusrprf", "notespassword")
logbody = logbody & Str(Now)_
& " Successfully connected to DB2/400" + Chr(10)

'-Set name of Notes view to use. Specify as/400 query and run it. Specify Name of Agent
' and save log document so if abend have something written, though error handler should complete it.
' --if view has more than one key column, define an array of type variant, which can hold either strings
' or numbers.

'//chg
Dim Keys (0 To 1) As Variant 'view has 2 key columns
Set View = db.GetView("XferCC")
logDoc.Activity = "CC"
Call logDoc.save(True,True,True) 'force save, no conflict doc, no unread mark
qry.SQL = "Select * from mylib.lnsrcnt order by LfCus#, LcType"

'-fetch 100 rcds at a time, making the receiving cache plenty big. if it overflows, agent
' just ends as if nothing happened. Primitive!!

fields.cacheLimit = 200
fields.FetchBatchSize = 100

'-if query got no fields, abort with msg to log
If Not fields.Execute Then
logbody = logbody & Str(Now)_
& " SQL failed or returned no records!!" + Chr(10)
Goto Disconnect
End If

'-Define all query fields as string or long (numbers). If not done, will get 'NULL' for empty as/400 data and
' compares won't do anything, meaning blank as/400 fields won't erase Notes document fields
-actually, usaing all 'variant' is safer
Dim CmCustNo As Long
Dim CcType As String
Dim CmName As String
Dim CmCity As String
Dim CmRgn As String
Dim CmGrp As String
Dim CcName As String
Dim CcTypeD As String
Dim CcPhone As String
Dim CcPhoneExt As String
Dim CcFax As String
Dim CcPhone800 As String
Dim CcEmail As String

'turn on dubug here to log each rcd's key in log

Dim LogDebug As Variant
'LogDebug = True
LogDebug = False
'*************************************************
'-loop to process all query rcds
'*************************************************
countfetch=0
countadd=0
countupd=0
countdel=0

Do
fields.NextRow
countfetch = countfetch + 1

'-Build key for accessing Notes document in special view that exists for this transfer. Check to see
' if document exists and set add or update mode. If found, store Notes id in list to prevent deletion

'//chg
CmCustNo = fields.GetValue("LFCUS#", CmCustNo)
CcType = fields.GetValue("LCTYPE", CcType)
Keys(0) = CmCustNo
Keys(1) = CcType
Set ViewDoc = View.GetDocumentByKey(Keys, True) ' true means exact match
If (ViewDoc Is Nothing) Then
UpdMode = "Add"
Else
UpdMode = "Update"
docidlist(ViewDoc.NoteId) = ViewDoc.NoteId 'store in list to prevent deletion
End If
'*****'
'-move all fields from query rcd to Notes document pgm fields
'*****'
CmName = fields.GetValue("LFCNAM",CmName)
CmCity = fields.GetValue("LFCITY",CmCity)
CmRgn = fields.GetValue("LFRGN", CmRgn)
CmGrp = fields.GetValue("LFGRP", CmGrp)
CcName = fields.GetValue("LCCNAM", CcName)
CcTypeD = fields.GetValue("LCTYPED", CcTypeD)
CcPhone = fields.GetValue("LCPHN", CcPhone)
CcPhoneExt = fields.GetValue("LCEXT", CcPhoneExt)
CcFax = fields.GetValue("LCFAX", CcFax)
CcPhone800 = fields.GetValue("LCPHN800", CcPhone800)
CcEmail = fields.GetValue("LCEMAIL", CcEmail)
'*****'
' ADD Mode. Write new document
'*****'
If UpdMode = "Add" Then
Set newDoc = New NotesDocument( db )

'//chg specify Notes form
newDoc.Form = "FrmCnt"

'//chg specify all fields here
newDoc.CmCustNo = CmCustNo
newDoc.CcType = CcType
newDoc.CmName = CmName
newDoc.CmCity = CmCity
newDoc.CmGrp = CmGrp
newDoc.CmRgn = CmRgn
newDoc.CcName = CcName
newDoc.CcTypeD = CcTypeD
newDoc.CcPhone = CcPhone
newDoc.CcPhoneExt = CcPhoneExt
newDoc.CcFax = CcFax
newDoc.CcPhone800 = CcPhone800
newDoc.CcEmail = CcEmail

'-Compute the new doc to get all other fields created, save the new document,
' store id in the list of ok documents for use by delete step

Call newdoc.ComputeWithForm( False, False ) '1st has no meaning, do not gen any errors
Call newdoc.save(True, True, False) 'force save, no conflict docs, want unread mark
docidlist(newdoc.NoteId) = newdoc.NoteId 'store notes id to prevent deletion

'//chg put keys in log msg
If LogDebug = True Then logbody = logbody & Str(Now)_
+ " added: " & Str$(CmCustNo) + ", " + CcType + Chr(10)
countadd = countadd + 1
End If
'*****'
' UPDATE Mode. Check each field and update only if something has changed
'*****'
If UpdMode = "Update" Then
IsChg = False

'-Compare each field in turn, setting the document field to the new value if different and setting
' on 'need to update' flag to signal that something in document has changed and update needed

'//chg
If ViewDoc.CmName(0) <> CmName Then
ViewDoc.CmName = CmName
IsChg = True
End If
If ViewDoc.CmCity(0) <> CmCity Then
ViewDoc.CmCity = CmCity
IsChg = True
End If
If ViewDoc.CmGrp(0) <> CmGrp Then
ViewDoc.CmGrp = CmGrp
IsChg = True
End If
If ViewDoc.CmRgn(0) <> CmRgn Then
ViewDoc.CmRgn = CmRgn
IsChg = True
End If
If ViewDoc.CcName(0) <> CcName Then
ViewDoc.CcName = CcName
IsChg = True
End If
If ViewDoc.CcTypeD(0) <> CcTypeD Then
ViewDoc.CcTypeD = CcTypeD
IsChg = True
End If
If ViewDoc.CcPhone(0) <> CcPhone Then
ViewDoc.CcPhone = CcPhone
IsChg = True
End If
If ViewDoc.CcPhoneExt(0) <> CcPhoneExt Then
ViewDoc.CcPhoneExt = CcPhoneExt
IsChg = True
End If
If ViewDoc.CcFax(0) <> CcFax Then
ViewDoc.CcFax = CcFax
IsChg = True
End If
If ViewDoc.CcPhone800(0) <> CcPhone800 Then
ViewDoc.CcPhone800 = CcPhone800
IsChg = True
End If
If ViewDoc.CcEmail(0) <> CcEmail Then
ViewDoc.CcEmail = CcEmail
IsChg = True
End If

'-Update the new document if anything different

If IsChg = True Then
Call ViewDoc.save(True, True, True) 'force save, no conflict doc creation, no unread marks
countupd = countupd + 1

'//chg put keys in log msg
If LogDebug = True Then logbody = logbody & Str(Now)_
+ " updated: " + Str$(CmCustNo) + ", " + CcType + Chr(10)
End If
End If
'*****
'-continue loop thru query rcds till reach end of data
'*****'
'Uncomment this line to do only xx fetches per run when testing. Cannot run delete section
'till this section runs completely or may delete documents that shouldn't get deleted!!!
'If countfetch >= 50 Then Goto Disconnect

Loop Until fields.IsEndOfData
'*************************************************
' Delete Processing. Loop thru view to locate any documents that need deleting
'*************************************************
'-record time delete process started

logbody = logbody & Str(Now)_
+ " Checking for deletes...." + Chr(10)

'-loop thru view from begin to end

Set ViewDoc = View.GetFirstDocument
Do While Not(ViewDoc Is Nothing)

'-have to get next document in view before deleting this one or won't be able to read next one
' this also constitutes the read of the next document for the loop

Set NextDoc = View.GetNextDocument(ViewDoc)

'-Check if Notes doc ID is in list of documents added or checked for chgs in query processing loop.
' If not there, rcd not longer exists on AS/400, so delete document

If Iselement(docidlist(ViewDoc.NoteId)) = False Then

'//chg put keys in log msg. this transfer logs all deletes. Use Str$ for numbers only
logbody = logbody & Str(Now)_
+ " deleted: " + Str$(ViewDoc.CmCustNo(0)) + "," + ViewDoc.CcType(0) + Chr(10)

'-remove the document
Call ViewDoc.Remove( True )
countdel = countdel + 1
End If

'-Make the next document already read the current document and continue the view loop

'Uncomment this line to do only xx fetches per run when testing
'If countdel >= 1 Then Goto disconnect
Set ViewDoc = NextDoc
Loop
'***********************************************'
' Disconnect. Close the query and connection. Update the log document. Exit procedure
'***********************************************'
Disconnect:
fields.Close(DB_CLOSE)
On Error Resume Next
con.Disconnect
On Error Resume Next
logbody = logbody & Str(Now)_
+ " Successfully disconnected from DB2." + Chr(10)
logDoc.FinishTime = Now
logDoc.Body = logbody
logDoc.Fetch = countfetch
logDoc.Update = countupd
logDoc.Insert = countadd
logDoc.Delete = countdel
Call logDoc.save(True,True,True) 'force save, no conflict doc, no unread mark
On Error Resume Next
Exit Sub
'***********************************************'
' Error Handler. Put the error line# and error text into the log file and branch to disconnect and update log doc
'***********************************************'
Handler:
logbody = logbody & Str(Now)_
+ " The following LotusScript error has occurred at statement" + Str$(Erl()) + " " + Error$ + Chr(10)
'-turn on error flag in agent log document so '!' appears in view
logDoc.Error = 1
Goto Disconnect
End Sub

previous page