为何Save As操作提示查找Windows系统文件夹而非指定文件路径？

核心问题点 #

• 重复打开工作簿：两次打开同一文件，既浪费资源，还可能导致Excel的当前路径被意外修改。
• SaveAs未指定完整路径：仅传入密码参数时，Excel会将文件保存到当前默认文件夹（可能变为Windows系统目录），而非原文件所在位置。
• 附件仅传文件名：Outlook添加附件时若只提供文件名，会默认在系统文件夹中查找，自然找不到目标文件。
• 循环复用同一邮件对象：所有收件人的附件会被添加到同一封邮件里，不符合批量发件逻辑。

修正后的代码 #

Sub FY23_PWProtectCompFile()
    Dim i As Integer
    Dim chapterComp As Workbook
    Dim emailList As Worksheet
    Dim pw As String
    Dim chapter As String
    Dim lastRow As Integer
    Dim attachmentPath As String
    Dim chapterFile As Workbook
    Dim outlookApp As Object
    Dim outlookMailItem As Object

    ' 初始化Outlook对象
    Set outlookApp = CreateObject("Outlook.Application")

    ' 仅打开一次数据源工作簿
    Set chapterComp = Workbooks.Open("I:\Calendar 2023\2023 Budget\2023 Misc. Budget Info\blahblah.xlsm")
    Set emailList = chapterComp.Sheets("EmailList")
    
    ' 获取有效数据的最后一行（避免End(xlDown)遇到空行提前停止的问题）
    lastRow = emailList.Cells(emailList.Rows.Count, "B").End(xlUp).Row

    For i = 2 To lastRow
        chapter = emailList.Range("B" & i).Value
        email = emailList.Range("H" & i).Value
        pw = emailList.Range("I" & i).Value
        attachmentPath = "C:\Users\blah\Documents\Chapters\" & chapter & ".xlsx"

        ' 打开目标文件，避免重复打开
        Set chapterFile = Workbooks.Open(attachmentPath)
        
        ' 保存时指定完整路径和文件名，覆盖原文件并加密
        chapterFile.SaveAs Filename:=attachmentPath, Password:=pw
        chapterFile.Close SaveChanges:=False ' 关闭文件，释放资源

        ' 为每个收件人新建一封邮件
        Set outlookMailItem = outlookApp.CreateItem(0)
        With outlookMailItem
            .To = email
            .Subject = chapter & " Compensation"
            .Body = "A copy of your compensation budget is attached!"
            .Attachments.Add attachmentPath ' 使用完整路径添加附件
            .Display ' 或改为.Send直接发送
        End With
    Next i

    ' 关闭数据源工作簿
    chapterComp.Close SaveChanges:=False
    Set outlookApp = Nothing
End Sub

关键修改说明 #

• 移除重复打开工作簿的代码，每个文件仅打开一次，避免路径混乱。
• SaveAs方法明确指定Filename参数为原文件完整路径，确保加密后的文件仍保存在原位置。
• 添加附件时使用完整文件路径，让Outlook直接定位到目标文件，不会去系统文件夹查找。
• 循环内新建Outlook邮件对象，确保每个收件人收到独立的邮件和对应附件。
• 使用lastRow = emailList.Cells(emailList.Rows.Count, "B").End(xlUp).Row获取最后一行，解决原代码中End(xlDown)遇到空行就停止的问题。
• 操作完成后关闭打开的工作簿，释放资源。

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