Office中国论坛/Access中国论坛

标题: 不知为什么不能重新命名新建文件夹，语句哪里有问题？ [打印本页]

作者: ljp518 时间: 2014-2-8 10:10
标题: 不知为什么不能重新命名新建文件夹，语句哪里有问题？
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"

      '每100个另选文件夹
      If i Mod 100 = 0 Then
         myFolder = GetFolder
      End If

      '       '其实如文件很多，不如设一个编号的文件夹,比较方便，不用另选。如：
      '       If i Mod 100 = 0 Then
      '          myFolder = myFolder & i
      '       End If

      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 = "回款类别"

作者: tmtony 时间: 2014-2-8 11:03
请说明具体哪句代码出错? 或上传相关的文件,大家才好帮你调试

作者: ljp518 时间: 2014-2-8 11:32
谢谢管理员！主要在这段语句中，另选文件夹不能命名
Set xlBook = xlApp.Workbooks.Open(myFolder & "\" & myfile)

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