Sunday, April 29, 2012

Import the data from ms excell to lotus notes view

%REM
    Agent Import
    Created Apr 3, 2012 by Roopesh Padoli/IT/polarisFT
    Description: Comments for Agent
%END REM
Option Public
Option Declare

Sub Initialize
   
   
    Dim session As New NotesSession
    Dim uiws As New NotesUIWorkspace
    Dim form As NotesForm
    Dim db As NotesDatabase
    Dim doc As NotesDocument
    Dim item As NotesItem
    Dim row As Integer
   
    Dim xlFilename As String
    Dim xlsApp As Variant
    Dim xlsWorkBook As Variant
    Dim xlsSheet As Variant
    Dim rows As Long
    Dim cols As Integer
    Dim x As Integer
    Dim itemName As String
    Dim flag As Integer
    Dim formAlias As String
    Dim sortEval As String
    Dim sortedList As Variant
    Dim indexLo As Long
    Dim indexHi As Long
    Dim fn As Variant
    Dim i As Variant
    Dim msg As Variant
    Set db = session.CurrentDatabase
   
   
    fn =uiws.OpenFileDialog(False,"Select the Excel File to Import", "c:My Documents")
    xlFilename = CStr(fn(0))
    Set form= db.GetForm("InputPrf")
   
    Print "Connecting to Excel..."
   
    Set xlsApp = CreateObject("Excel.Application")
   
    Print "Opening the file : " & xlfilename
    xlsApp.Workbooks.Open xlfilename
    Set xlsWorkBook = xlsApp.ActiveWorkbook
    Set xlsSheet = xlsWorkBook.ActiveSheet
    xlsApp.Visible = False
    xlsSheet.Cells.SpecialCells(11).Activate
    rows = xlsApp.ActiveWindow.ActiveCell.Row
    cols = xlsApp.ActiveWindow.ActiveCell.Column
   
    row = 0
    Print "Starting import from Excel file..."
    Do While True
        row = row + 1
        If row= rows+1 Then GoTo Done
        If row=1 Then
            For i=1 To cols
                ReDim Preserve fd(i)
                fd(i)=xlsSheet.Cells( row, i ).Value
                flag=0
               
                ForAll f In form.Fields
                    If LCase(fd(i)) = LCase(f) Then flag=1
                End ForAll
               
                If flag=1 Then
                    GoTo Skip
                End If
                If Not flag=1 Then
                    msg="The field name "& fd(i) &" does not appear In the form you have chosen.Exiting import."
                    MsgBox msg
                   
                End If
Skip:
            Next
        End If
       
        If Not row = 1 Then
           
           
            Set doc = db.CreateDocument
            doc.Form = "InputPrf"
           
            For i= 1 To cols
                Set item = doc.ReplaceItemValue( fd(i),        xlsSheet.Cells( row, i ).Value )
            Next
           
           
            Call doc.Save( True, True )
           
        End If      
        Print "Processing document number "& CStr(row) & " of " & CStr(rows)
 
    Loop
Done:
   
    Print "Disconnecting from Excel..."
    xlsWorkbook.Close False
    xlsApp.Quit
    Set xlsApp = Nothing
    Print " "
   
End Sub

No comments:

Post a Comment