VBA刷新客户数据并保存指定工作表至新路径时遇1004错误求助

Hey there, let's tackle your two core issues and get your macro running exactly as you need it to. I've broken down the fixes and rewritten the code to align with your desired workflow:

Core Problems & Solutions #

1. Runtime Error 1004 (Save Failure) #

This usually happens due to:

• Missing save directories
• Invalid characters in filenames
• Targeting the wrong workbook/worksheet after copying
• Trying to overwrite open files

2. Premature Execution Before Refresh Completes #

RefreshAll runs asynchronously by default (especially for SQL/Power Query connections), so we need to force synchronous refreshes and add a wait loop to confirm data is fully loaded.

Full Corrected Macro #

Sub ClientDataRefresh()
    Dim wsOutput As Worksheet
    Dim wsTemplate As Worksheet
    Dim rngClients As Range
    Dim clientCell As Range
    Dim savePath As String
    Dim fileName As String
    Dim todayDate As String
    Dim newWB As Workbook
    Dim conn As WorkbookConnection
    Dim lastRow As Long
    Dim clientName As String
    
    ' Set explicit references to avoid relying on active objects
    Set wsOutput = ThisWorkbook.Worksheets("Output")
    Set wsTemplate = ThisWorkbook.Worksheets("Template")
    Set rngClients = ThisWorkbook.Range("Clients")
    
    ' Define your target save path
    savePath = "C:\Users\nalanis\Dropbox (Decipher Dev)\Analytics\Sales\"
    ' Create the directory if it doesn't exist (prevents 1004 errors)
    If Dir(savePath, vbDirectory) = "" Then
        MkDir savePath
    End If
    
    ' Format date safely for filenames (no slashes)
    todayDate = Format(Date, "yyyy-mm-dd")
    
    ' Speed up macro and avoid pop-ups
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Force all connections to refresh synchronously
    For Each conn In ThisWorkbook.Connections
        Select Case conn.Type
            Case xlConnectionTypeODBC, xlConnectionTypeOLEDB
                conn.OLEDBConnection.BackgroundQuery = False
            Case xlConnectionTypeTEXT
                conn.TextConnection.BackgroundQuery = False
        End Select
    Next conn
    
    ' Loop through each client in your dropdown list
    For Each clientCell In rngClients
        ' Set current client in the Output sheet
        wsOutput.Range("C5").Value = clientCell.Value
        
        ' Refresh data and wait for completion
        ThisWorkbook.RefreshAll
        ' Extra check to ensure all refreshes finish (critical for SQL/Power Query)
        Do Until ThisWorkbook.RefreshAll = False
            DoEvents
        Loop
        
        ' Auto-fit columns in Output sheet
        wsOutput.Range("A1:O10").Columns.AutoFit
        
        ' Set print area for Template sheet (cleaner than GoTo loop)
        lastRow = wsTemplate.Cells(wsTemplate.Rows.Count, 7).End(xlUp).Row
        Do While wsTemplate.Cells(lastRow, 7).Value = "" And lastRow > 1
            lastRow = lastRow - 1
        Loop
        wsTemplate.PageSetup.PrintArea = "$A$1:$I$" & lastRow
        
        ' Get client name and clean invalid filename characters
        clientName = wsTemplate.Range("H7").Text
        ' Replace Windows-illegal characters with underscores
        clientName = Replace(clientName, "/", "_")
        clientName = Replace(clientName, "\", "_")
        clientName = Replace(clientName, ":", "_")
        clientName = Replace(clientName, "*", "_")
        clientName = Replace(clientName, "?", "_")
        clientName = Replace(clientName, """", "_")
        clientName = Replace(clientName, "<", "_")
        clientName = Replace(clientName, ">", "_")
        clientName = Replace(clientName, "|", "_")
        
        ' Build final filename
        fileName = clientName & " Usage Report " & todayDate & ".xlsx"
        
        ' Copy Template to new workbook
        wsTemplate.Copy
        Set newWB = ActiveWorkbook
        
        ' Save new workbook (xlsx format automatically removes VBA)
        newWB.SaveAs Filename:=savePath & fileName, FileFormat:=xlOpenXMLWorkbook
        
        ' Close the new workbook without prompts
        newWB.Close SaveChanges:=False
    Next clientCell
    
    ' Restore application settings
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "All client reports generated successfully!", vbInformation
End Sub

Key Improvements #

• Explicit References: Uses ThisWorkbook instead of ActiveWorkbook to avoid errors if other workbooks are open, and eliminates unreliable Select/Activate commands.
• Path Validation: Creates the save directory if it doesn't exist (a top cause of 1004 errors).
• Filename Sanitization: Removes all Windows-illegal characters from client names to prevent save failures.
• Synchronous Refreshes: Disables background queries so RefreshAll waits for data to fully load before proceeding.
• Clean Print Area: Replaces the GoTo loop with a more readable Do While loop to find the last non-blank row.
• Automatic VBA Removal: Saving as .xlsx (FileFormat xlOpenXMLWorkbook) strips all VBA code from the output files automatically.

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