怎樣在導(dǎo)出表的這段程序中增加一個(gè)選擇新文件夾的語(yǔ)句？謝謝！

ljp518 · 發(fā)表于 2013-8-1 10:38:56

隨著導(dǎo)出的表格增加，一個(gè)文件夾存放溢出，造成程序中斷；能不能在文件夾存不下的情況下，提示選擇新文件夾，確定后繼續(xù)運(yùn)行，直致所有的表導(dǎo)出完成，謝謝！下附程序
Private Sub 全部導(dǎo)出_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 業(yè)務(wù)員 FROM 結(jié)算 GROUP BY 業(yè)務(wù)員;"
rs1.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

For i = 1 To rs1.RecordCount
myfile = rs1("業(yè)務(wù)員") & ".xls"
If myFSO.FileExists(myFolder & "\" & myfile) = False Then
      Call CreatE(myfile, myFolder)
End If

sql2 = "SELECT * FROM 結(jié)算 where 業(yè)務(wù)員='" & rs1("業(yè)務(wù)員") & "'"
rs2.Open sql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
Set xlBook = xlApp.Workbooks.Open(myFolder & "\" & myfile)
'導(dǎo)出主表
xlBook.Application.Sheets(1).Select
xlBook.Application.Range("A1").Value = "姓名:"
xlBook.Application.Range("B1").Value = rs1("業(yè)務(wù)員")

xlBook.Application.Range("A2").Value = "回款日期"
xlBook.Application.Range("b2").Value = "廠名"
xlBook.Application.Range("c2").Value = "回款類別"
xlBook.Application.Range("d2").Value = "地區(qū)"
xlBook.Application.Range("e2").Value = "產(chǎn)品"
xlBook.Application.Range("f2").Value = "分配金額"
xlBook.Application.Range("g2").Value = "單價(jià)"
xlBook.Application.Range("h2").Value = "分配數(shù)量"
xlBook.Application.Range("i2").Value = "考核率"
xlBook.Application.Range("j2").Value = "增長(zhǎng)率"

'導(dǎo)出子表
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("地區(qū)")
      xlBook.Application.Cells(j + 2, 5).Value = rs2("產(chǎn)品")
      xlBook.Application.Cells(j + 2, 6).Value = rs2("分配金額")
      xlBook.Application.Cells(j + 2, 7).Value = rs2("單價(jià)")
      xlBook.Application.Cells(j + 2, 8).Value = rs2("分配數(shù)量")
      xlBook.Application.Cells(j + 2, 9).Value = rs2("考核率")
      xlBook.Application.Cells(j + 2, 10).Value = rs2("增長(zhǎng)率")

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

End Sub