Sub Initialize
Dim FileNum As Integer
Dim xlFilename As String
Filenum% = Freefile()
xlFileName$ = Inputbox("What file name and path? example:H:
\June282001.xls")
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Set db = session.CurrentDatabase
Set doc = New NotesDocument(db)
Dim One As String
Dim row As Integer
Dim written As Integer
'// Next we connect to Excel and
open the file. Then start pulling over the records.
Dim Excel As Variant
Dim xlWorkbook As Variant
Dim xlSheet As Variant
Print "Connecting to Excel..."
Set Excel = CreateObject( "Excel.Application.8" )
Excel.Visible = False '// Don't display the Excel window
Print "Opening " & xlFilename & "..."
Excel.Workbooks.Open xlFilename '// Open the Excel file
Set xlWorkbook = Excel.ActiveWorkbook
Set xlSheet = xlWorkbook.ActiveSheet
'// Cycle through the rows of the
Excel file, pulling the data over to Notes
Goto Records
Print "Disconnecting from Excel..."
xlWorkbook.Close False '// Close the Excel file without saving (we
made no changes)
Excel.Quit '// Close Excel
Set Excel = Nothing '// Free the memory that we'd used
Print " " '// Clear the status line
Records:
row = 0 '// These integers intialize to zero anyway
written = 0
Print "Starting import from Excel file..."
Do While True
Finish:
With xlSheet
row = row + 1
Set view = db.GetView("Main View")
Set doc = db.CreateDocument '// Create a new doc
doc.Form = "ImportForm1"
If .Cells (row, 1).Value = "" And .Cells(row,2).Value = ""
And .Cells (row, 3).Value = "" And .Cells(row,4).Value = "" And .Cells
(row, 5).Value = "" And .Cells(row,6).Value = "" And .Cells (row, 7).Value
= "" And .Cells(row,8).Value = "" And .Cells (row, 9).Value = "" And
.Cells(row,10).Value = ""Then
Goto Finish
End If
If .Cells (row, 1).Value = "PO #" And .Cells(row,2).Value
= "Order #" And .Cells (row, 3).Value = "Order da" And .Cells(row,4).Value
= "Part #" And .Cells (row, 5).Value = "Or" And .Cells(row,6).Value
= "Line " And .Cells (row, 7).Value = "Qty" And .Cells(row,8).Value
= "Unit pri" And .Cells (row, 9).Value = "Ship to Company" And
.Cells(row,10).Value = "Ship method"Then
Goto Finish
End If
doc.SWEPO = .Cells( row, 1 ).Value
doc.SWEORDER = .Cells(row, 2 ).Value
doc.SWEORDERDATE = .Cells(row, 3).Value
doc.ITEMNUMBER = .Cells( row, 4 ).Value
doc.ORDERSTATUS = .Cells(row, 5).Value
doc.QUANTITYORDERED = .Cells( row, 6).Value
doc.AMOUNTBILLED = .Cells(row, 7).Value
doc.SHIPMETHOD = .Cells( row, 8).Value
doc.SHIPDATE = .Cells(row, 9).Value
doc.TRACKINGNUMBER = .Cells(row, 10).Value
Call doc.Save( True, True ) '// Save the new doc
written = written + 1
Print written
If written = 5 Then
Print written
Goto Finish
Else
Print written
Messagebox "Finished"
Goto Done
End If
End With
Loop
Return
Done:
End Sub
This was first published in July 2001