Importing to Record from Excel

    Question by:


    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

    Ask Your Tech Question. Get Expert Solutions.We will email you when an expert has commented on your question.

    We will never share this with anyone. Privacy Policy Terms of Use

    Select topics

    You may select up to five topics.

    Top Expert Contributor

    Essential articles and videos from the Experts

    More valuable questions with Expert answers


    RELATED TOPICS view all topics

    1. Exchange
    2. Email Clients
    3. MS Excel
    4. Outlook
    5. Email Servers
    6. Blackberry Hardware
    7. Email Protocols
    8. MS Access
    9. Visual Basic Classic
    10. Databases