%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
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