This imports data from Excel into Lotus Notes, skipping blank lines and column headers. This will only import 100...
records at a time and can be changed by changing the written value.
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