VBA使用SaveAs保存新文件时出现运行时错误1004求助

Hey there, let's work through that frustrating 1004 error you're hitting when trying to save your filtered workbook. This error almost always stems from issues with your file path/filename, plus a couple of small tweaks to make your code more reliable. Here's the breakdown:

Key Causes of the Error #

• Illegal characters in the filename: When you append the raw dte variable to your filename, it uses your system's default date format (e.g., mm/dd/yyyy). The / character is not allowed in Windows filenames, which breaks the SaveAs command.
• Potential path issues: Your file path includes a single quote (') in ' Operations Metrics—while Windows allows this, VBA can sometimes misinterpret special characters in paths. Also, double-check that the target folder actually exists (missing folders will trigger this error too).
• Permission restrictions: Make sure you have write access to the target folder on the K drive.

Additional Code Improvements #

Your current method for copying filtered data might accidentally include hidden rows or miss data. Using SpecialCells(xlCellTypeVisible) ensures you only copy the visible, filtered rows.

Revised Working Code #

Sub GIACTSDS121()
    Dim dte As Date
    Dim mBox As Variant
    Dim Lastrow As Long
    Dim sourceWS As Worksheet
    Dim newWB As Workbook
    
    ' Get and validate date input
    mBox = InputBox("Enter a date")
    If Not IsDate(mBox) Then
        MsgBox "This is not a date. Please try again"
        Exit Sub
    End If
    dte = CDate(mBox)
    
    ' Set reference to source worksheet for clarity
    Set sourceWS = ActiveSheet
    Lastrow = sourceWS.Range("A" & sourceWS.Rows.Count).End(xlUp).Row
    
    ' Apply filters
    sourceWS.Range("A1:AC" & Lastrow).AutoFilter Field:=2, Criteria1:=">=" & dte, _
        Operator:=xlAnd, Criteria2:="<" & dte + 1
    sourceWS.Range("A1:AC" & Lastrow).AutoFilter Field:=21, Criteria1:="Yes"
    
    ' Copy only visible filtered data
    sourceWS.Range("A1:AC" & Lastrow).SpecialCells(xlCellTypeVisible).Copy
    
    ' Create new workbook and paste data
    Set newWB = Workbooks.Add
    newWB.ActiveSheet.Paste
    Application.CutCopyMode = False ' Clear clipboard
    
    ' Delete unnecessary columns
    newWB.ActiveSheet.Range("A:A,E:E,I:I,M:N,Q:T,X:Z").EntireColumn.Delete
    
    ' Use a valid date format for filename, fix path if needed
    Dim savePath As String
    ' Removed the single quote from the path to avoid parsing issues
    savePath = "K:\K_Drive\RP\RPS-Metrics-ops\Operations Metrics\Investigation Documentation\GIACT Investigations\SDS_Cases\_" & Format(dte, "yyyy-mm-dd") & ".xlsx"
    
    ' Save and close the new workbook
    newWB.SaveAs Filename:=savePath, FileFormat:=51
    newWB.Close SaveChanges:=False
End Sub

Key Changes Made #

• Replaced raw dte with Format(dte, "yyyy-mm-dd") to create a filename-safe date string (no illegal / characters).
• Removed the single quote from the path to eliminate potential VBA parsing issues.
• Used SpecialCells(xlCellTypeVisible) to reliably copy only filtered, visible rows.
• Added explicit worksheet/workbook references (sourceWS, newWB) to avoid relying on ActiveSheet/ActiveWorkbook, which makes the code more stable.
• Added Application.CutCopyMode = False to clear the clipboard after pasting.

Final Checks #

1. Double-verify that the target folder exists on your K drive.
2. Confirm you have write permissions for that folder.
3. Test with a simple date (like 10/05/2024) to ensure the filename generates correctly.

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