notes导入导出Excel

notes和Excel交换数据
从Domino导出
Sub Click(Source As Button)
On Error Goto errorMessage
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim view As NotesView
Dim excelApplication As Variant
Dim excelWorkbook As Variant
Dim excelSheet As Variant
Dim i As Integer
Dim excelSave As New NotesUIWorkspace
Dim excelFileName As Variant
Dim viewName As Variant

Set doc = session.DocumentContext
viewName = Evaluate(|@Text(@ViewTitle)|,doc)
Msgbox "view:" + viewName(0)
Forall v In viewName
Msgbox "viewname:" + v
End Forall
Set db=session.CurrentDatabase
viewName=https://www.wendangku.net/doc/7111299025.html,

Set view=db.GetView(viewName)
Set doc=view.GetFirstDocument
If Not(doc Is Nothing ) Then
Set excelApplication=CreateObject("Excel.Application")
excelFileName=excelSave.SaveFileDialog(False,"选择您所要保存的路径","dd")
If excelFileName(0) <>"" Then
excelFileName(0)=excelFileName(0)+".xls"
End If
If Not(Isempty(excelFileName)) Then
excelApplication.Visible = True
Set excelWorkbook=excelApplication.Workbooks.Add
Set excelSheet = excelWorkbook.Worksheets("Sheet1")
excelSheet.Cells(1,1).Value="姓名"
excelSheet.Cells(1,2).Value="年龄"
excelSheet.Cells(1,3).Value="电话"
i=1
Dim j,z As Variant
j=0
j=j+1
z=j

While Not(doc Is Nothing)
i=i+1
excelSheet.Cells(i,z).Value=doc.customerName(0)
excelSheet.Cells(i,z+1).Value=doc.customerAge(0)
excelSheet.Cells(i,z+2).Value=doc.customerTel(0)
Set doc=view.GetNextDocument(doc)
Wend

End If
End If
excelSheet.Columns("A").Select
excelSheet.Columns("A").EntireColumn.AutoFit
excelWorkbook.SaveAs(excelFileName(0))
excelApplication.Quit
Set excelApplication=Nothing

errorMessage:
If Error <> "" Then
Msgbox "错误信息： " +Error$ +" 错误行："+Cstr(Erl)+"行"
End If

End Sub


从Excel导入

Sub Click(Source As Button)
On Error Goto errorMessage
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim view As NotesView
Dim excelApplication As Variant
Dim excelWorkbook As Variant
Dim excelSheet As Variant
Dim i As Integer
Dim excelSave As New NotesUIWorkspace
Dim excelFileName As Variant
Dim viewName As Variant

Set doc = session.DocumentContext
viewName = Evaluate(|@Text(@ViewTitle)|,doc)
Msgbox "view:" + viewName(0)
Forall v In viewName
Msgbox "viewname:" + v
End Forall
Set db=session.CurrentDatabase
viewName=https://www.wendangku.net/doc/7111299025.html,

Set view=db.GetView(viewName)
Set doc=view.GetFirstDocument
If Not(doc Is Nothing ) Then
Set excelApplication=CreateObject("Excel.Application")
excelFileName=excelSave.SaveFileDialog(False,"选择您所要保存的路径","dd")
If excelFileName(0) <>"" Then
excelFileName(0)=excelFileName(0)+".xls"
End If
If Not(Isempty(excelFileName)) Then
excelApplication.Visible = True
Set excelWo

rkbook=excelApplication.Workbooks.Add
Set excelSheet = excelWorkbook.Worksheets("Sheet1")
excelSheet.Cells(1,1).Value="姓名"
excelSheet.Cells(1,2).Value="年龄"
excelSheet.Cells(1,3).Value="电话"
i=1
Dim j,z As Variant
j=0
j=j+1
z=j

While Not(doc Is Nothing)
i=i+1
excelSheet.Cells(i,z).Value=doc.customerName(0)
excelSheet.Cells(i,z+1).Value=doc.customerAge(0)
excelSheet.Cells(i,z+2).Value=doc.customerTel(0)
Set doc=view.GetNextDocument(doc)
Wend

End If
End If
excelSheet.Columns("A").Select
excelSheet.Columns("A").EntireColumn.AutoFit
excelWorkbook.SaveAs(excelFileName(0))
excelApplication.Quit
Set excelApplication=Nothing

errorMessage:
If Error <> "" Then
Msgbox "错误信息： " +Error$ +" 错误行："+Cstr(Erl)+"行"
End If

End Sub