2013年10月30日 星期三

[AP] Import Excel

還未驗證
Ref. from http://ymh70.blogspot.tw/2008/03/excelnotesnotes.html
'//------------------
Sub Initialize
Dim s As notessession
Dim ws As notesuiworkspace
Dim db As notesdatabase
Dim doc As notesdocument
Dim xl As Variant
Dim xlwbk As Variant
Dim xlsht As Variant
Dim selected As Variant
Dim filename As String
Dim row As Integer
Set ws = New notesuiworkspace
selected = ws.openfiledialog(False,"請選擇你要匯入的檔案", "Microsoft Excel|*.xls", "")
If Isempty(selected) Then
Messagebox "您沒有選擇要匯入的檔案", 16, "訊息"
Exit Sub
End If
filename = selected(0)
Set xl = createobject("Excel.Application")
xl.visible = False
xl.workbooks.open filename
Set xlwbk = xl.activeworkbook
Set xlsht = xlwbk.activesheet
row = 2 '第一列是抬頭從第二列開始
Set s = New notessession
Set db = s.currentdatabase
Set view = db.getview("PersonByEmpNoForAll") '比對資料視界
i=1
Do Until Cstr(Trim(xlsht.cells(row, 1).value)) = ""
keystr = Ucase(Cstr(Trim(xlsht.cells(row, 1).value)))
'第一個欄位當值
Set doc = view.getdocumentbykey(Ucase(Cstr(Trim(xlsht.cells(row, 1).value))), False)
If Not(doc Is Nothing) Then 
doc.BPMProperty= Ucase(Cstr(Trim(xlsht.cells(row, 2).value))) '抓取第二個欄位當值更新 
doc.UPDateField = "Yes" 
Call doc.save(False, False)
Print "第 " & i & " " & doc.EmployeeNo(0) & " " & doc.BPMProperty(0) & " 更新成功" 
i=i+1
Else
Print "第 " & i & " " & keystr & " 找不到文件更新" 
End If
row = row + 1
Loop
Call ws.viewrefresh
Messagebox "匯入完成", 64, "訊息"
End Sub

沒有留言:

張貼留言