Importing to Record from Excel

Lotus IBM Question

I am trying to get some script together which will allow the data from a spreadsheet to be imported into a form. I will have a spreadsheet where the Office ID is in the first column, I will have a record open in notes which will have the Office in a field on the form. I want the system to look through each row of the spreadsheet and pull in the data if it matches the office ID on the open record. The code below is close but it forces me to separate the data for each office into its own tab. On the form I will have a series of fields in a table that the data will fall into. Below is just a basic layout where Import 1a..b..c would be the data that has matched this office ID from columns A,B,C in the spreadsheet. Hopefully what I am asking for amkes sense, appreciate any assistance.

Import1a  Import 1b  Import 1c
Import2a  Import 2b  Import 2c
Import3a  Import 3b  Import 3c
Import4a  Import 4b  Import 4c
Import5a  Import 5b  Import 5c

Sub Click(Source As Button)
      Dim session As New NotesSession
      Dim workspace As New NotesUIWorkspace
      Dim db As NotesDatabase
      Dim doc As NotesDocument
      Dim item As NotesItem
      Dim Filename As String
      Set db = session.CurrentDatabase
      Set uidoc = workspace.CurrentDocument
      Set doc = uidoc.Document
      Dim xlapp As Variant
      Dim xlsheet As Variant
      Dim x As Long
      Filename = "C:\dlm_refresh\dlm_refresh.xls"
'      Excel.Workbooks.Open Filename '// Open the Excel file
      Set xlapp = GetObject( Filename , "" )
      shtname= doc.office_id(0)   '  each sheet in excel is named with the agency 3-character id.  I pull this from the doc to locate the correct sheet.
      Set xlsheet = xlapp.WorkSheets( shtname )
      doc.userid1 = Clng(xlsheet.range("C2").value)
      doc.userid2 = Clng(xlsheet.range("C3").value)
      doc.userid3 = Clng(xlsheet.range("C4").value)
      doc.userid4 = Clng(xlsheet.range("C5").value)
      doc.userid5 = Clng(xlsheet.range("C6").value)
      doc.asset1 = Clng(xlsheet.range("B2").value)
      doc.asset2 = Clng(xlsheet.range("B3").value)
      doc.asset3 = Clng(xlsheet.range("B4").value)
      doc.asset4 = Clng(xlsheet.range("B5").value)
      doc.asset5 = Clng(xlsheet.range("B6").value)
      Messagebox "Import done successfully."
      Set xls = Nothing
      Set sheet = Nothing
End Sub


Verified Answer?

The member who asked this question verified this comment provided the solution that solved their problem.

by:Posted on 2006-03-31 at 19:12:35ID: 16348111

Or you can paste this into an agent, shared, Target = None, security = 3

It will create a view to make sure you're not importing stuff twice, and will create a field for each title in the first row.  But, I did account for Asset, userid and office_id.  

Please make sure you read the comments and configure the CONST values.

'Import Excel:

Option Public
Option Declare

'Important set these values to your environment..........
Const str_VIEWNAME="Excel Import Check"
Const str_FORM = "Refresh Tracking"
Const str_IMPORTFILE="C:\assettracking.xls"
Const max_RECORDS=100                   'Set this to the maximum number of records you want to loop
Const max_SKIPROWS=10                    'Set this to the number of blank rows you want to skip before you assume
                                                                       'the rest of the worksheet is blank
'I am using these to concatentate three column values into a unique key to avoid importing duplicates
Const chk_COL1=2       'Asset
Const chk_COL2=3       'userid
Const chk_COL3=4       'office_id
Sub Initialize
          'Clear Lotus Notes View Of Employee Records    
      Dim session As New NotesSession
      Dim db As NotesDatabase
      Dim view As NotesView
      Dim vColl As NotesViewEntryCollection
      Dim max_Columns As Integer
      Set db = session.currentdatabase
      Set view = db.getview(str_VIEWNAME)
      If view Is Nothing Then
            Set view = CreateChkView(session)
            If view Is Nothing Then
                  Msgbox "Sorry, unable to create the check view to avoid importing duplicate documents"
                  Exit Sub
            End If
      End If
      Dim xlFilename As String
     'IMPORT FILENAME.............................................
      xlFilename= str_IMPORTFILE
      Dim doc As NotesDocument, titles As Variant
      Dim row As Integer, col As Integer, k As Integer
      Dim written As Integer            
      On Error Goto Handle_Error
     'First Connect to Excel and see if there are any records to import......................
      Dim Excel As Variant
      Dim xlWorkbook As Variant
      Dim xlSheet As Variant
      Print "Connecting to Excel..."
      Set Excel = CreateObject( "Excel.Application" )
      If Excel Is Nothing Then
            Print "Unable to open the excel object..."
            Exit Sub
      End If
      Excel.Visible = False '// Don't display the Excel window
      Excel.Workbooks.Open xlFilename '// Open the Excel file
      Print "Opening " & xlFilename & "..."
      Set xlWorkbook = Excel.Workbooks(1)
      Set xlSheet = Excel.Workbooks(1).Worksheets(1)
      Dim chk As String, skiprow As Integer
      Dim FieldNames(255) As String, tmpStr As String
      row = 1 '// These integers intialize to zero anyway
      col = 1
      written =0      
      Print "Starting import from Excel file..."      
      With xlSheet
            For k = 1 To 255
                  tmpStr =Format(.cells(row,k).value)
                  If Len(Trim(tmpStr))>0 Then
                        FieldNames(k) = tmpStr
                        Select Case K
                        Case 1
                              Msgbox "First Row and Column in the worksheet must contain the Field Titles",,"Column Title Missing"
                              Exit Sub
                        Case Else
                              max_COLUMNS = k-1
                              Exit For
                        End Select
                  End If
      End With
      Row = 2      
      Do While (row<=max_RECORDS)  
            With xlSheet                  
                  chk =Lcase(Trim(Format(.cells(row,chk_COL1).value) + _
                  Format(.cells(row,chk_COL2).value) + _
                  If Len(chk)<0 Then
                        skiprow = skiprow +1
                        Goto NextRow
                  End If                  
                  Select Case row
                  Case 1
                        'Header Row is Titles
                  Case Else
                        If Len(chk)>0 Then
                        'Check to see if the document has been created
                              Set doc = view.GetDocumentByKey(chk, True)
                              If Not doc Is Nothing Then Goto NextRow
                              Set doc = New NotesDocument(db)
                              doc.Form = str_FORM  'Form name
                              'Update to Fields
                              For k = 1 To max_COLUMNS                                          
                                    Call doc.ReplaceItemValue(FieldNames(k), Format(xlsheet.cells(row, k).value))                                                
                              doc.Save True, False, True
                              Print " Creating Record..." + Cstr(row)                  
                              written = written +1
                                     'If we find a record, then set the skiprow back to 0 - it was just a blank row
                              skiprow = 0
                              Set doc = Nothing
                        End If
                  End Select                  
            End With        
            row= row+1
            If skiprow =>max_SKIPROWS Then
                  Print Cstr(max_SKIPROWS) + " blank rows reached... assuming the rest of the worksheet is blank..."
                  Exit Do
            End If
      Print "Disconnecting from Excel..."
      Excel.Quit '// Close Excel
      Set Excel = Nothing '// Free the memory that we'd used
      Exit Sub
      If Err = 213 Then
            Print "Import File not found..."
            Err = 0
            Exit Sub
      End If
      On Error Goto 0
      If Not xlworkbook Is Nothing Then
            Excel.activeworkbook.close         '// Close the Excel file without saving (we made no changes)
            Excel.Quit '// Close Excel
            Set Excel = Nothing '// Free the memory that we'd used
      End If
      Exit Sub
End Sub
Sub Terminate
End Sub

Function CreateChkView(thisSession As NotesSession) As NotesView
      Dim tmpView As NotesView, columnCount As Integer      
      Dim strSelect As String, strCOL As String
      ColumnCount = 0
      strSelect = {SELECT ((Form = "} + str_FORM + {"));@All}
      strCOL={@LowerCase(@Text(Asset) + @Text(UserID) + @Text(OfficeID))}
      Set tmpView = thisSession.currentdatabase.CreateView(str_VIEWNAME, strSelect)
      If Not tmpView Is Nothing Then
            Dim col As NotesViewColumn, Col1 As NotesViewColumn, Col2 As NotesViewColumn, Col3 As NotesViewColumn            
            Set col = tmpView.CreateColumn(1, "KEY", strCOL)
            Col. IsSorted = True
            Set col1 = tmpView.CreateColumn(2, "Asset", "Asset")
            Set col2 = tmpView.CreateColumn(3, "UserID", "userid")
            Set col3 = tmpView.CreateColumn(4, "Office ID", "office_id")
            Set CreateChkView = tmpView            
      End If      
End Function

This content is available to Experts Exchange members

See the answer now
with your Free 30 Day Trial

Get unlimited access to solutions & experts

  • 4,169,477 solved questions
  • 3,805 articles & videos
  • 15,413 tech experts

Get Access Now

Need a customized answer?
Ask your question for one-on-one assistance. We will email you when an expert has commented on your question.

We will never share this with anyone.


Related Articles

Related Questions

Experts Exchange powers the growth and success
of technology professionals worldwide.

  • Solve

    Experts Exchange is the tech professional’s trusted, on-demand resource for solving difficult problems, making informed decisions, and delivering excellent solutions.

  • Learn

    With unparalleled access to technical experts, verified real-world solutions, and diverse educational content, Experts Exchange enables personalized development of technology skills.

  • Network

    Experts Exchange gives you the professional exposure and valued relationships key to building the career you want.

Join the Network Today

See Plans and Pricing