Office中国论坛/Access中国论坛

标题: 怎样在导出表的这段程序中增加一个选择新文件夹的语句？谢谢！ [打印本页]

作者: ljp518 时间: 2013-8-1 10:38
标题: 怎样在导出表的这段程序中增加一个选择新文件夹的语句？谢谢！
随着导出的表格增加，一个文件夹存放溢出，造成程序中断；能不能在文件夹存不下的情况下，提示选择新文件夹，确定后继续运行，直致所有的表导出完成，谢谢！下附程序
Private Sub 全部导出_Click()
Dim myFSO As New FileSystemObject
Dim myFolder As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset
Dim sql1 As String, sql2 As String
Dim i As Long, j As Long
Dim myfile As String
myFolder = GetFolder

sql1 = "SELECT 业务员 FROM 结算 GROUP BY 业务员;"
rs1.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

For i = 1 To rs1.RecordCount
myfile = rs1("业务员") & ".xls"
If myFSO.FileExists(myFolder & "\" & myfile) = False Then
      Call CreatE(myfile, myFolder)
End If

sql2 = "SELECT * FROM 结算 where 业务员='" & rs1("业务员") & "'"
rs2.Open sql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
Set xlBook = xlApp.Workbooks.Open(myFolder & "\" & myfile)
'导出主表
xlBook.Application.Sheets(1).Select
xlBook.Application.Range("A1").Value = "姓名:"
xlBook.Application.Range("B1").Value = rs1("业务员")

xlBook.Application.Range("A2").Value = "回款日期"
xlBook.Application.Range("b2").Value = "厂名"
xlBook.Application.Range("c2").Value = "回款类别"
xlBook.Application.Range("d2").Value = "地区"
xlBook.Application.Range("e2").Value = "产品"
xlBook.Application.Range("f2").Value = "分配金额"
xlBook.Application.Range("g2").Value = "单价"
xlBook.Application.Range("h2").Value = "分配数量"
xlBook.Application.Range("i2").Value = "考核率"
xlBook.Application.Range("j2").Value = "增长率"

'导出子表
For j = 1 To rs2.RecordCount
      xlBook.Application.Cells(j + 2, 1).Value = rs2("回款日期")
      xlBook.Application.Cells(j + 2, 1).NumberFormatLocal = "yyyy/m/d;@"
      xlBook.Application.Cells(j + 2, 2).Value = rs2("厂名")
      xlBook.Application.Cells(j + 2, 3).Value = rs2("回款类别")
      xlBook.Application.Cells(j + 2, 4).Value = rs2("地区")
      xlBook.Application.Cells(j + 2, 5).Value = rs2("产品")
      xlBook.Application.Cells(j + 2, 6).Value = rs2("分配金额")
      xlBook.Application.Cells(j + 2, 7).Value = rs2("单价")
      xlBook.Application.Cells(j + 2, 8).Value = rs2("分配数量")
      xlBook.Application.Cells(j + 2, 9).Value = rs2("考核率")
      xlBook.Application.Cells(j + 2, 10).Value = rs2("增长率")

      rs2.MoveNext
Next
xlBook.Save
xlApp.Quit
rs1.MoveNext
rs2.Close
Next
rs1.Close

End Sub

作者: tmtony 时间: 2013-8-1 12:18
可判断这个文件夹下的文件数,然后提示

作者: ljp518 时间: 2013-8-1 13:21
这个程序是老大爷做的，相当好用，自己不会改，谁能帮改一下，不胜感激！

作者: ljp518 时间: 2013-8-1 15:54
再顶一下{:soso_e127:}

作者: ljp518 时间: 2013-8-2 09:01
{:soso_e127:}再顶

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)