新建一代理,在Notes客戶端運行此代理:
Sub Initialize
On Error Goto errhandle
Set F = New f_default
Msgbox "開始。。。。"
Dim ws As New NotesUIWorkspace
Dim ss As New NotesSession
Dim db As NotesDatabase
Dim files As Variant
Dim schar As String
Dim doc As NotesDocument
Dim excelapplication
Dim i,sheet
Set db = ss.CurrentDatabase
files = ws.openfiledialog(False,"請選擇要導入的Excel文件","Excel file/*.xls")
sheeet = 1
If Not(Isempty(files)) Then '如果用戶選擇了文件,或者輸入了文件名,那麼就開始準備打開excel文件。
Set excelapplication = createobject("excel.application")
Set excelworkbook = excelapplication.workbooks.open(files)
If excelworkbook Is Nothing Then '如果未找到文件,則退出
excelapplication.quit
Exit Sub
End If
Set excelsheet = excelworkbook.worksheets(1)
i = 2 '從第二行開始讀取'一個sheet裏面所有記錄循環
Do Until Cstr(excelsheet.cells(i,1).value) =""
Set doc = New NotesDocument(db)
doc.Form = "f_XCPKFLX" '表單名
doc.MingCheng = "" + excelsheet.cells(i,1).value + ""
'doc.jiaohuodanhao = excelsheet.cells(i,2).value '交貨單號
'doc.yifuyunfei = excelsheet.cells(i,3).value '已付運費
'doc.kaifeisuozaidi = excelsheet.cells(i,4).value '開票所在地
doc.SYS_SUBMITDATE = Cstr(Now())
doc.Creater = "CN=admin/O=org"
doc.Admin_SYS = "HR管理員"
Dim item As NotesItem
Set item = doc.GetFirstItem("Admin_SYS")
item.AppendToTextList("CN=admin/O=org")
item.AppendToTextList("工作門戶系統管理員羣組")
item.AppendToTextList("工作門戶系統管理員羣組")
item.AppendToTextList("系統管理員")
Call F.SetItemProperty(doc,"Admin_SYS","R")'設置權限
doc.AllEditors = "*"
Call F.SetItemProperty(doc,"AllEditors","R")
doc.Replicate_SYS = "LocalDomainServers"
Call F.SetItemProperty(doc,"Replicate_SYS","R")
doc.SYSTEM="*"
Call F.SetItemProperty(doc,"SYSTEM","R") 'Read
doc.SYS_SYSTEM="*"
Call F.SetItemProperty(doc,"SYS_SYSTEM","R")
Call doc.save(True,False) '保存
i=i+1
Loop
excelworkbook.close(False)
excelapplication.quit
Set excelapplication = Nothing
End If
Msgbox "完成!"
Exit Sub
errhandle:
Call F.printerrmsg(doc,"Initialize")
Exit Sub
End Sub
On Error Goto errhandle
Set F = New f_default
Msgbox "開始。。。。"
Dim ws As New NotesUIWorkspace
Dim ss As New NotesSession
Dim db As NotesDatabase
Dim files As Variant
Dim schar As String
Dim doc As NotesDocument
Dim excelapplication
Dim i,sheet
Set db = ss.CurrentDatabase
files = ws.openfiledialog(False,"請選擇要導入的Excel文件","Excel file/*.xls")
sheeet = 1
If Not(Isempty(files)) Then '如果用戶選擇了文件,或者輸入了文件名,那麼就開始準備打開excel文件。
Set excelapplication = createobject("excel.application")
Set excelworkbook = excelapplication.workbooks.open(files)
If excelworkbook Is Nothing Then '如果未找到文件,則退出
excelapplication.quit
Exit Sub
End If
Set excelsheet = excelworkbook.worksheets(1)
i = 2 '從第二行開始讀取'一個sheet裏面所有記錄循環
Do Until Cstr(excelsheet.cells(i,1).value) =""
Set doc = New NotesDocument(db)
doc.Form = "f_XCPKFLX" '表單名
doc.MingCheng = "" + excelsheet.cells(i,1).value + ""
'doc.jiaohuodanhao = excelsheet.cells(i,2).value '交貨單號
'doc.yifuyunfei = excelsheet.cells(i,3).value '已付運費
'doc.kaifeisuozaidi = excelsheet.cells(i,4).value '開票所在地
doc.SYS_SUBMITDATE = Cstr(Now())
doc.Creater = "CN=admin/O=org"
doc.Admin_SYS = "HR管理員"
Dim item As NotesItem
Set item = doc.GetFirstItem("Admin_SYS")
item.AppendToTextList("CN=admin/O=org")
item.AppendToTextList("工作門戶系統管理員羣組")
item.AppendToTextList("工作門戶系統管理員羣組")
item.AppendToTextList("系統管理員")
Call F.SetItemProperty(doc,"Admin_SYS","R")'設置權限
doc.AllEditors = "*"
Call F.SetItemProperty(doc,"AllEditors","R")
doc.Replicate_SYS = "LocalDomainServers"
Call F.SetItemProperty(doc,"Replicate_SYS","R")
doc.SYSTEM="*"
Call F.SetItemProperty(doc,"SYSTEM","R") 'Read
doc.SYS_SYSTEM="*"
Call F.SetItemProperty(doc,"SYS_SYSTEM","R")
Call doc.save(True,False) '保存
i=i+1
Loop
excelworkbook.close(False)
excelapplication.quit
Set excelapplication = Nothing
End If
Msgbox "完成!"
Exit Sub
errhandle:
Call F.printerrmsg(doc,"Initialize")
Exit Sub
End Sub