Excel VBA批量刷新查询并导出工作表问题求助

问题根源 #

1. 执行逻辑颠倒：原代码先刷新查询再切换E9单元格的值，导致刷新的始终是旧值对应的查询结果，完全搞反了流程。
2. 固定等待无效：Application.Wait固定等待10秒，无法精准匹配查询实际完成时间，要么浪费时间，要么查询未完成就执行后续导出。
3. 路径语法错误：destinationFolder = destinationFolder & "\""多了一个闭合双引号，会导致路径格式异常。
4. 工作簿引用不灵活：硬编码工作簿名称TEA.xlsm，不如直接引用当前工作簿更可靠。

修正后的完整代码 #

Sub RefreshAll()
    ' 直接引用当前工作簿，避免硬编码名称
    ThisWorkbook.RefreshAll
    ' 强制等待所有查询刷新完成
    Do Until Application.CalculationState = xlDone
        DoEvents
    Loop
End Sub

Public Sub Create_workbooks()
    Dim destinationFolder As String
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    
    destinationFolder = "C:\Users\Maqlly\Desktop\Vouchers"
    ' 修正路径拼接的语法错误
    If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
         
    Set dataValidationCell = Worksheets("sheet2").Range("E9")
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
     
    ' 遍历数据验证列表值
    For Each dvValueCell In dataValidationListSource
        ' 1. 先切换E9的值
        dataValidationCell.Value = dvValueCell.Value
        ' 2. 刷新查询并等待完成
        Call RefreshAll
        ' 3. 导出当前Sheet2为独立文件
        Worksheets("sheet2").Copy
        With ActiveWorkbook
            .SaveAs Filename:=destinationFolder & dvValueCell.Value, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close False
        End With
    Next
End Sub

关键修改说明 #

• 调整执行顺序：先切换E9的值，再触发查询刷新，确保刷新的是当前选中值对应的数据。
• 精准等待查询完成：用Do Until Application.CalculationState = xlDone循环等待，直到所有查询、计算完成，替代固定时长等待。
• 修复路径语法错误：移除多余的双引号，保证路径格式正确。
• 优化工作簿引用：用ThisWorkbook替代硬编码的工作簿名称，适配工作簿重命名场景。

内容的提问来源于stack exchange，提问作者Maqlly