Sub Click(Source As Button)
'-------------------------------------------------------------
'-- PeiQingbin Excle导入--2
'-------------------------------------------------------------
Dim ws As New NotesUIWorkspace 'workspace
Dim ss As New NotesSession 'session
Dim db As NotesDatabase 'database
Dim item As NotesItem 'notes item
Dim files As Variant 'file name
Dim schar As String 'cell content
Dim doc As NotesDocument 'notes document
Dim dc As NotesDocumentCollection 'notes documents collection
Dim excelapplication 'Excel
Dim i,j As Integer 'number counter
Dim rowcount As Integer 'rows that need operate
Set db = ss.currentdatabase
Set dc=db.UnprocessedDocuments
rowcount=dc.Count
Messagebox("您选中了" + Cstr(rowcount) + "条记录,请您准备好文件,本次操作仅导入文件中的前" + Cstr(rowcount) + "条记录。" + Chr(13)+Chr(10)+"如果文件内数据行数不足,将以空值或0添入数据库。")
files = ws.openfiledialog(False,"请选择要导入的Excel文件","Excel file/*.xls")
If Not(Isempty(files)) Then
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 '从第二行开始读取
Set doc=dc.GetFirstDocument
While Not (doc Is Nothing)
doc.sjfypc = excelsheet.cells(i,1).value '实际发运批次
doc.fyzt = excelsheet.cells(i,2).value '发运状态
doc.jtfysj = excelsheet.cells(i,3).value '具体发运时间
doc.fy_loadmark="Excel 导入 at " + Cstr(Now())
Call doc.save(False,False) '保存
i=i+1
Set doc=dc.GetNextDocument(doc)
Wend
excelworkbook.close(False)
excelapplication.quit
Set excelapplication = Nothing
End If
End Sub
'-------------------------------------------------------------
'-- PeiQingbin Excle导入--2
'-------------------------------------------------------------
Dim ws As New NotesUIWorkspace 'workspace
Dim ss As New NotesSession 'session
Dim db As NotesDatabase 'database
Dim item As NotesItem 'notes item
Dim files As Variant 'file name
Dim schar As String 'cell content
Dim doc As NotesDocument 'notes document
Dim dc As NotesDocumentCollection 'notes documents collection
Dim excelapplication 'Excel
Dim i,j As Integer 'number counter
Dim rowcount As Integer 'rows that need operate
Set db = ss.currentdatabase
Set dc=db.UnprocessedDocuments
rowcount=dc.Count
Messagebox("您选中了" + Cstr(rowcount) + "条记录,请您准备好文件,本次操作仅导入文件中的前" + Cstr(rowcount) + "条记录。" + Chr(13)+Chr(10)+"如果文件内数据行数不足,将以空值或0添入数据库。")
files = ws.openfiledialog(False,"请选择要导入的Excel文件","Excel file/*.xls")
If Not(Isempty(files)) Then
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 '从第二行开始读取
Set doc=dc.GetFirstDocument
While Not (doc Is Nothing)
doc.sjfypc = excelsheet.cells(i,1).value '实际发运批次
doc.fyzt = excelsheet.cells(i,2).value '发运状态
doc.jtfysj = excelsheet.cells(i,3).value '具体发运时间
doc.fy_loadmark="Excel 导入 at " + Cstr(Now())
Call doc.save(False,False) '保存
i=i+1
Set doc=dc.GetNextDocument(doc)
Wend
excelworkbook.close(False)
excelapplication.quit
Set excelapplication = Nothing
End If
End Sub