VBA代码按单元格日期重命名文件时保存路径不符问题咨询

我明白你的问题啦——代码能正常按日期重命名文件，但文件没存到你浏览选择的目标文件夹，反而留在原文件所在的位置了对吧？这大概率是你在SaveAs时没指定好目标文件夹的路径，误用到了原文件的路径导致的。下面是调整后的代码，你把它放到Do Events部分下方，就能实现将重命名后的文件保存到你选择的文件夹里：

Sub RenameAndSaveToSelectedFolder()
    Dim strSelectedFolder As String
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wb As Workbook
    Dim newFileName As String
    Dim targetDate As String
    
    ' 获取要保存的目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择要保存文件的目标文件夹"
        If .Show = -1 Then
            strSelectedFolder = .SelectedItems(1)
        Else
            ' 用户取消选择，退出程序
            MsgBox "未选择目标文件夹，程序退出。"
            Exit Sub
        End If
    End With
    
    ' 确保文件夹路径末尾有反斜杠，避免拼接错误
    If Right(strSelectedFolder, 1) <> "\" Then
        strSelectedFolder = strSelectedFolder & "\"
    End If
    
    ' 获取当前工作簿H2单元格的日期，格式化为适合文件名的格式（比如yyyy-mm-dd）
    targetDate = Format(ThisWorkbook.Range("H2").Value, "yyyy-mm-dd")
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' 这里替换成你要浏览的源Excel文件所在文件夹路径，或者也可以再加一个文件夹选择框让用户选源文件夹
    Set objFolder = objFSO.GetFolder("C:\你的源文件文件夹路径") ' 请替换为实际源文件夹
    
    For Each objFile In objFolder.Files
        ' 只处理Excel文件
        If objFSO.GetExtensionName(objFile.Path) Like "xls*" Then
            On Error Resume Next
            Set wb = Workbooks.Open(objFile.Path)
            On Error GoTo 0
            
            If Not wb Is Nothing Then
                ' 生成新文件名：日期+原文件名（可根据需求调整命名规则）
                newFileName = targetDate & "_" & objFSO.GetBaseName(objFile.Path) & "." & objFSO.GetExtensionName(objFile.Path)
                
                ' 保存到目标文件夹，而不是原文件路径
                wb.SaveAs Filename:=strSelectedFolder & newFileName, FileFormat:=wb.FileFormat
                wb.Close SaveChanges:=False
                Set wb = Nothing
            End If
        End If
    Next objFile
    
    MsgBox "文件重命名并保存完成！"
End Sub

关键调整点说明： #

• 新增了目标文件夹选择功能：用msoFileDialogFolderPicker让你选择要保存文件的文件夹，并把路径存在strSelectedFolder变量里。
• 路径拼接处理：确保目标文件夹路径末尾有反斜杠，避免拼接新文件名时出现路径错误（比如变成C:\FolderNewFileName.xlsx而不是C:\Folder\NewFileName.xlsx）。
• SaveAs时明确指定目标路径：用strSelectedFolder & newFileName作为保存路径，而不是依赖原文件的Path属性，这样文件就会存到你选择的文件夹里了。
• 额外处理：只筛选Excel文件（xls/xlsx等），避免处理其他类型文件；增加了错误处理，防止文件打开失败导致程序崩溃。

如果你的源文件文件夹也需要手动选择，而不是固定路径，你可以再添加一个FolderPicker来获取源文件夹路径，替换掉代码里的"C:\你的源文件文件夹路径"即可。

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