怎么导出到指定的excle文件中呢？
如题！
导出到新建EXCLE没问题，就是想导到已经编辑过的EXCLE中，好做数据源用。
[解决办法]
Set xlApp = CreateObject("Excel.application")
xlApp.Workbooks.Open( strFilePath ）
'后面的操作和新建EXCLE的导出是一样的了
'strFilePath 就是你的那个已经存在的EXCLE文件路径及文件名
[解决办法]
Sub Click(Source As Button)
On Error Goto p
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim s As New NotesSession
Dim db As NotesDatabase
Dim ajDC As NotesDocumentCollection
Dim ajDoc As NotesDocument
Dim larq As String '立案日期
Dim formula As String
Const path2Save = "E:\立案统计报表" '存储路径
Dim ygBuff As String '原告信息
Dim bgBuff As String '被告信息
Dim mcArray As Variant
Dim dwArray As Variant '地位
Dim dhArray As Variant '电话
Dim rowBegin As Integer
Dim ii As Integer
Dim xlsApp As Variant 'Excel对象
Set xlsApp = CreateObject("Excel.application")
If Not(xlsApp Is Nothing) Then
'在这个 Excel 文件当中添加一个 Sheet
xlsApp.Workbooks.Add
xlsApp.Visible = True
ii = 1
rowBegin = 1
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 1).Value = "序号"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 2).Value = "案号"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 3).Value = "案件类型"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 4).Value = "原告信息"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 5).Value = "被告信息"
REM 导出数据至Excel
Set uidoc = ws.CurrentDocument
larq = Format(uidoc.FieldGetText("LARQ"),"yyyy年mm月dd日")
Set db = s.CurrentDatabase
formula = "(Form = 'Mostly')& (LARQ='"+larq+"')"
Set ajDC = db.Search(formula,Nothing,0)
Set ajDoc = ajDC.GetFirstDocument
While Not(ajDoc Is Nothing)
ygBuff = ""
bgBuff = ""
mcArray = Split(ajDoc.MC(0),"|")
dhArray = Split(ajDoc.LXDH(0),"|")
If(ajDoc.HasItem("DW"))Then
dwArray = Split(ajDoc.DW(0),"|")
For index = 0 To Ubound(dwArray)
If("原告" = dwArray(index) Or "申请人" = dwArray(index))Then
ygBuff = ygBuff + mcArray(index) + "##" + Trim(dhArray(index)) + "；"
Else
If("被告" = dwArray(index) Or "被申请人" = dwArray(index))Then
bgBuff = bgBuff + mcArray(index) + "##" + Trim(dhArray(index)) + "；"
End If
End If
Next
Else
For index = 0 To Ubound(mcArray)
bgBuff = bgBuff + mcArray(index) + "##" + Trim(dhArray(index)) + "；"
Next
End If
rowBegin = ii + 1
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 1).Value = Cstr(ii)
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 2).Value = ajDoc.AH(0)
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 3).Value = ajDoc.ajlx(0)
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 4).Value = ygBuff
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 5).Value = bgBuff
Set ajDoc = ajDC.GetNextDocument(ajDoc)
ii = ii + 1
Wend
xlsApp.Workbooks(1).Worksheets(1).Columns("A:E").EntireColumn.AutoFit
If(Dir(path2Save,16) = "")Then '检查目录是否已经存在
Mkdir(path2Save)
End If
xlsApp.ActiveWorkbook.SaveAs( path2Save+"\"+larq+".xls")
'关闭资源
xlsApp.Quit
'资源释放
Set xlsApp = Nothing
'Msgbox("报表已经生成！")
'打开报表
ws.URLOpen(path2Save+"\"+larq+".xls")
End If
Exit Sub
p:
Msgbox(Erl())
End Sub
导入
Sub Click(Source As Button)
'-------------------------
'-- PeiQingbin Excle导入--
'-------------------------
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 excelapplication
Dim i,sheet
Set db = ss.currentdatabase
files = ws.openfiledialog(False,"请选择要导入的Excel文件","Excel file/*.xls")
sheeet = 1
If Not(Isempty(files)) Then
Set excelapplication = createobject("excel.application")
Set excelworkbook = excelapplication.workbooks.open(files)
'多个sheet循环
'Do Until Cstr(excelsheet.cells(i,sheet).value) =""
Set excelsheet = excelworkbook.worksheets(1)
i = 2 '从第二行开始读取
'一个sheet里面所有记录循环
Do Until Cstr(excelsheet.cells(i,1).value) =""
Set doc = New NotesDocument(db)
doc.Form = "物资计划"
doc.xmmc = excelsheet.cells(i,1).value '项目名称
doc.jhbh = excelsheet.cells(i,2).value '计划编号
doc.bpbj_gybh = excelsheet.cells(i,3).value '工艺编号
doc.bpbj_gybh = excelsheet.cells(i,3).value '工艺编号
doc.bpbj_sblx = excelsheet.cells(i,4).value '设备类别
doc.bpbj_sbzl = excelsheet.cells(i,5).value '设备子类
doc.bpbj_sbcd = excelsheet.cells(i,6).value '设备产地
doc.bpbj_mc = excelsheet.cells(i,7).value '备件名称
doc.bpbj_bjbh = excelsheet.cells(i,8).value '备件编号
doc.bpbj_shzq = excelsheet.cells(i,9).value '损耗周期
doc.bpbj_bjsjsl = excelsheet.cells(i,10).value '备件实际数量
doc.bpbj_jykc = excelsheet.cells(i,11).value '建议库存
doc.bpbj_ysxx_sccj = excelsheet.cells(i,12).value '原始信息
doc.bpbj_ysxx_pp = excelsheet.cells(i,13).value
doc.bpbj_ysxx_xh = excelsheet.cells(i,14).value
doc.bpbj_zhxx_sccj = excelsheet.cells(i,15).value '转化信息
doc.bpbj_zhxx_pp = excelsheet.cells(i,16).value
doc.bpbj_zhxx_xh = excelsheet.cells(i,17).value
doc.bpbj_bz = excelsheet.cells(i,18).value '备注
Call doc.save(False,False) '保存
i=i+1
Loop
'Loop
excelworkbook.close(False)
excelapplication.quit
Set excelapplication = Nothing
End If
End Sub
