[AP] 挑選excel 檔匯入notes doc

Function SP_ImportExcel4Law()
'//匯入違反條文的excel內容
'//欄位：違反標準、條文、說明
On Error Goto errorhandler
Dim jmcws As New NotesUIWorkspace
Dim jmcSession As New NotesSession
Dim DB As NotesDatabase, NewDoc As NotesDocument
Dim fn As Variant, xlFilename As String
Dim xlsApp As Variant, xlsWorkBook As Variant, xlsSheet As Variant
Dim rows As Long, cols As Integer, firstRow As Integer
Dim itemAuthor As NotesItem, itemReader As NotesItem

Set DB = jmcSession.CurrentDatabase

     'Get Excel file name
fn =jmcws.OpenFileDialog(False,  "Select the Excel File to Import",  "Excel files | *.xls", "c:My Documents")
xlFilename = Cstr(fn(0)) ' This is the  name of the Excel file that will be imported

'Open the file
Print "Opening the file : " & xlFilename
Set xlsApp = CreateObject("Excel.application")
xlsApp.Workbooks.Open (xlFilename)
Set xlsWorkBook = xlsApp.ActiveWorkbook
Set xlsSheet = xlsWorkBook.ActiveSheet
xlsApp.Visible = False ' Do not  show Excel to user
xlsSheet.Cells.SpecialCells(11).Activate
rows = xlsApp.ActiveWindow.ActiveCell.Row   ' Number of rows to process 有幾行資料
cols = xlsApp.ActiveWindow.ActiveCell.Column   ' Number of columns to process  有幾欄資料


Print "import from Excel file start..."

firstRow = 2
intRow = firstRow
Do While ( xlsSheet.Cells(intRow, 1).Value <> "" )
Set NewDoc = New NotesDocument(db)
Call NewDoc.ReplaceItemValue("Form", "Form-IsoQsLaw")
Set itemAuthor = New NotesItem(NewDoc,"DocAuthors","[QC OP.]",AUTHORS)
Call NewDoc.ReplaceItemValue("DocAuthors", SP_AryAddItem(NewDoc.DocAuthors, "[ITM OP.]"))
Set itemReader = New NotesItem (NewDoc,"DocReaders","*",READERS)

Call NewDoc.ReplaceItemValue("IsoQs", Cstr(xlsSheet.Cells(intRow, 1).Value))   '//違反標準
Call NewDoc.ReplaceItemValue("IsoQsLaw", Cstr(xlsSheet.Cells(intRow, 2).Value))   '//條文
Call NewDoc.ReplaceItemValue("IsoQsDesc", Cstr(xlsSheet.Cells(intRow, 3).Value))   '//說明

Call Newdoc.Save(True, False)
intRow = intRow + 1
Loop

xlsApp.Quit
Print "import from Excel file end..."
Messagebox "Import ok!  Rowcount : " & Cstr(intRow -firstRow), 0, "Warning"

TheEnd:
Exit Function
ErrorHandler:
Print "ag: Import...: SP_ImportExcel4Law() error line = " + Cstr(Erl) + ", error = " + Error$
xlsApp.Quit
Resume TheEnd
End Function