欢迎来到Doc100.Net免费学习资源知识分享平台!
您的位置:首页 > 程序异常 >

如何导出到指定的excle文件中呢

更新时间: 2014-01-05 03:01:35 责任编辑: Author_N1

 

怎么导出到指定的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")
上一篇:上一篇
下一篇:下一篇

 

随机推荐程序问答结果

 

 

如对文章有任何疑问请提交到问题反馈,或者您对内容不满意,请您反馈给我们DOC100.NET论坛发贴求解。
DOC100.NET资源网,机器学习分类整理更新日期::2014-01-05 03:01:35
如需转载,请注明文章出处和来源网址:http://www.doc100.net/bugs/t/17463/
本文WWW.DOC100.NET DOC100.NET版权所有。