Import From Excel To Lotus

Dim con As New ODBCConnection
Dim qry As New ODBCQuery
Dim result As New ODBCResultSet
Dim Session As New NotesSession
Dim Db As NotesDatabase
Dim COView As NotesView
Dim CODoc As NotesDocument
Dim BillDirectionDoc As NotesDocument
Dim Row As Integer
Dim BillDirection As String
 
 
Set Db = Session.CurrentDatabase
Set COView = Db.GetView(    "BillDirections:DirCode" )
 
Set qry.Connection = con
Set result.Query = qry
con.ConnectTo( "STAT2" )
qry.SQL = "SELECT * FROM STAT2"
result.Execute
 
Do
result.NextRow
Row = Row + 1
.............................................

Function ConnectToXLS As Variant
Dim ProfileDoc As NotesDocument
Dim ADOConnection As Variant
 
 
On Error GoTo OnErr
 
Set ProfileDoc = GetProfileDocument
If ProfileDoc Is Nothyng Then
ConnectToXLS = "1"
Exit Function
End If
 
Set ADOConnection = CreateObject("ADODB.Connection")
 
With ADOConnection
.Provyder = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source="+ ProfileDoc.ExcelDebet( 0 ) + ";Extended Properties=Excel 8.0;"
.Mode = 1
.Open
End With
 
Set ConnectToXLS = ADOConnection
 
Exit Function
 
OnErr:
Print Error
Set ConnectToXLS = Nothyng
Set ADOConnection = Nothyng
Resume Rez
 
Rez:
 
End Function

    Set XLSConnection = ConnectToXLS
 
If XLSConnection Is Nothyng Then
GoTo OnErr
End If
 
Set RecordSet = CreateObject("ADODB.Recordset")
RecordSet.LockType = 3
RecordSet.CursorType = 2
RecordSet.Open "Select * from [Sheet1$] where F2 <>  " , XLSConnection
 
While RecordSet.EOF = False
..... делаем то что надо
Wend

    RecordSet.Open "Select * from STAT2 " , XLSConnection

Sub ImportFromExcel
 
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
 
Set db = Session.currentdatabase
 
filename = Inputbox$ ("Drive\Path\FileName.xls for the docs будут загружены.", "Укажите расположение файла импорта " ,"c:\export.xls")
If filename = "" Then
Exit Sub
End If
 
formname = Inputbox$ ("Форма для загрузки?", "Enter ... " ,"Topic")
If formname = "" Then
Exit Sub
End If
 
Set xlApp = CreateObject("Excel.application")
Set ws = New NotesUIWorkspace
Установка видимости Excel -------------------------------------------------
Watch = "No"
If Watch = "Yes" Then YesNo = True Else YesNo = False
xlApp.Visible = YesNo
открытие книги ------------------------------------------------------------
 
Call xlApp.Workbooks.Open(filename, 0, True)
Set xlsheet = xlApp.Workbooks(1).Worksheets(1)
xlsheet.Activate
 
Dim RowName As String
With xlsheet
i=1  начинаем со второй строчки
Do
RowName = Trim(Str(i + 1))
---------------------------------------------------------
создать
Set CurrDoc = New NotesDocument (db)
CurrDoc.Form=formname
CurrDoc.Category3=.Range("A" & RowName).Value
CurrDoc.Category2=.Range("B" & RowName).Value
CurrDoc.CatalogNumber=.Range("C" & RowName).Value   Артикул
Call CurrDoc.ComputeWithForm(True, True)
Call CurrDoc.Save(True, True)
---------------------------------------------------------
Print i
i = i +1
Loop While (Trim(.Range("A" + RowName).Value)<>"")  пока колонка "A" Category непустое :)
End With
 
xlapp.activeworkbook.close
xlapp.quit
Set xlapp = Nothyng
 
Messagebox("Import file Excel " & FileName & " is complete. Всего создано " & i & " записей. ")
Call ws.ViewRefresh
 
End Sub