Import DBF files to Lotus Notes

Николай Тарасенко

Ниже приведен код агента который импортирует все DBF файлы из указанной директории.

Обращаю внимание, если у Вас Windows 7 x64 тогда для настройки ODBC источника необходимо использовать ODBC 32.

c:\Windows\SysWOW64\odbcad32.exe


%REM
Agent ImportDBF
Created Aug 5, 2015 by Nikolay Tarasenko
Description: Import DBF files
%END REM
Option Public
Option Declare

UseLSX "*LSXODBC"
Sub Initialize
On Error GoTo ErrorTrap
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim con As New ODBCConnection
Dim qry As New ODBCQuery
Dim result As New ODBCResultSet
Dim Status As Integer
Dim i As Integer
Dim fieldInfo As String
Dim ODBCSourceName As String

Set db = session.Currentdatabase

Dim dirDBF As String
dirDBF = "C:\DBF\UBF1\"
ODBCSourceName = "TEK"

REM =================================
status = con.ConnectTo( ODBCSourceName )
If Not con.IsConnected Then
MessageBox "Could not connect to " & ODBCSourceName & " database -- Did you register the ODBC Data Source???",, "Error"
Exit Sub
End If
Set qry.Connection = con
Set result.Query = qry
'====================================

'GET DBF Files
Dim pathname As String, filename As String
pathname = "C:\DBF\UBF1\*.dbf"
filename = Dir(pathname, 16)
Do While filename<>""

qry.SQL = |SELECT * FROM "|+filename+|"|
If qry.GetError <> DBstsSUCCESS Then
MessageBox qry.GetExtendedErrorMessage,, "Query Error" & qry.GetError & " " & qry.GetErrorMessage
Exit Sub
End If

Call result.Execute

If result.IsResultSetAvailable Then
Do
result.NextRow
REM Create a Notes Document, assign values, save the document. Do it until we're done.
Set doc = db.CreateDocument ' Create a new Notes Document for this record
doc.form = "REC"
Call doc.Replaceitemvalue("File",dirDBF+filename)
doc.ImportDateTime = Now

For i = 1 To result.NumColumns
Call doc.Replaceitemvalue(result.FieldName(i),result.GetValue( result.FieldName(i) ))
Next

Call doc.save( True, False )
Loop Until result.IsEndOfData

End if

REM =================================
result.Close( DB_CLOSE )
'====================================

filename=Dir()
Loop

Exit Sub
ErrorTrap:
MsgBox CStr(Err) & ": " & Error
Exit Sub
End Sub