怎样在导出表的这段程序中增加一个选择新文件夹的语句？谢谢！

ljp518

随着导出的表格增加，一个文件夹存放溢出，造成程序中断；能不能在文件夹存不下的情况下，提示选择新文件夹，确定后继续运行，直致所有的表导出完成，谢谢！下附程序
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

可判断这个文件夹下的文件数,然后提示

ljp518

这个程序是老大爷做的，相当好用，自己不会改，谁能帮改一下，不胜感激！

ljp518

再顶一下{:soso_e127:}

ljp518

{:soso_e127:}再顶