[AP] 匯出至excel

Function SP_ExportReport01() As Integer
'//匯出excel報表, for monthly
On Error Goto errorhandler
Call jmcf_blnSetNewUIVars()
'Excel 相關變數
Dim xlApp As Variant, xlSheet As Variant , rows As Integer, cols As Integer, maxcols As Integer
Dim pvi As NotesView, pdoc As NotesDocument, pcol As NotesDocumentCollection
Dim strInput As String, strViewNm As String
'

strInput = jmcws.Prompt(PROMPT_OKCANCELEDIT,"輸入西元年4碼月份2碼","ex: 2013/09","")
If Trim(strInput) = "" Then Exit Function

'//(rows, cols) = 橫, 欄
'//start Excel with OLE Automation
Set xlApp = CreateObject("Excel.Application")
xlApp.StatusBar = "Creating WorkSheet. Please be patient..."
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.ReferenceStyle = 2
Set xlsheet = xlApp.Workbooks(1).Worksheets(1)

'//設定excel title字型
xlApp.Rows("1:1").Select
xlApp.Selection.Font.Bold = True
xlApp.Selection.Font.Underline = False
xlApp.Selection.Font.Name = "Arial"
xlApp.Selection.Font.Size = 10
xlApp.Selection.Columns.AutoFit

cols = 1
rows = 1

'//欄位名稱
xlsheet.Cells(rows, cols).Value = "當班出缺勤_" + strInput
rows = rows + 1
xlsheet.Cells(rows, cols).Value = "日期"
cols = cols + 1
xlsheet.Cells(rows, cols).Value = "工號"
cols = cols + 1
xlsheet.Cells(rows, cols).Value = "姓名"
cols = cols + 1
xlsheet.Cells(rows, cols ).Value = "時數"
cols = cols + 1
xlsheet.Cells(rows, cols).Value = "建制班別"
cols = cols + 1
xlsheet.Cells(rows, cols).Value = "請假項目"
cols = cols + 1
xlsheet.Cells(rows, cols).Value = "請假說明"

maxcols = cols
rows = rows + 1

strViewNm = "View-AbsenceItem1ByMonth"
Set pvi = jmcdb.getview(strViewNm)
If pvi Is Nothing Then Error 997, "not fount view: " + strViewNm
Set pcol = pvi.GetAllDocumentsByKey(strInput, True)
If pcol.Count = 0 Then Error 997, "not found documents." : Exit Function
Set pdoc = pcol.GetFirstDocument()

'//塞資料
With xlApp.Worksheets(1)
Do While Not pdoc Is Nothing
.Cells(rows, 1).Value = pdoc.AbDate(0)
.Cells(rows, 2).Value = pdoc.AbEmpNo(0)
.Cells(rows, 3).Value = pdoc.AbEmpNm(0)
.Cells(rows, 4).Value = pdoc.AbHour(0)
.Cells(rows, 5).Value = pdoc.Abshift_desc(0)
.Cells(rows, 6).Value = pdoc.AbItem(0)
.Cells(rows, 7).Value = pdoc.AbDescription(0)
rows = rows + 1
Set pdoc = pcol.GetNextDocument(pdoc)
Loop
End With

'//設定內容的字型
xlApp.Range(xlsheet.Cells(2,1), xlsheet.Cells(rows,maxcols)).Select
xlApp.Selection.Font.Size = 10
xlApp.ReferenceStyle = 1
xlApp.Range("A1").Select
xlApp.StatusBar = "Importing Data from Lotus Notes Application was Completed."
Set xlApp = Nothing   'stop OLE


TheEnd:
Exit Function
ErrorHandler:
Set xlApp = Nothing   'stop OLE
Print "lib-SP.ReferenceAction4UI: SP_ExportReport01 error line = " + Cstr(Erl) + ", error = " + Error$
Call SP_ErrorBox("lib-SP.ReferenceAction4UI: SP_ExportReport01 error")
Resume TheEnd
End Function