VBA

Question

我正在尝试 this method 将一个工作簿中的单独 sheet 另存为文件，并将这些文件作为附件发送到单独的电子邮件中。

保存文件正常，但当它尝试发送电子邮件时，我收到此“运行-time error '-2147024894 (80070002)'：找不到此文件。验证路径和文件名是否正确”不幸的是，我已经被这个错误困扰了很长时间 - 任何建议将不胜感激！

我已经命名了 Splitcode 范围并且它正在工作，因为这些文件进入了 ActiveWorkbook 文件夹。我在 sheet 的 D 列中有附件名称，它们在文件中的显示方式完全相同。（见截图 - EmailAddress tab w/ Splitcode）

ActiveWorkbook 文件夹仅包含活动工作簿，直到宏运行和文件（Timecard-E1.xlsm 等）出现在其中。

代码如下：

Sub SaveAndSend()

Dim Splitcode As Range
Dim Path As String
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim email As Range
Path = Application.ActiveWorkbook.Path
Set OutApp = CreateObject("Outlook.Application")
Set Splitcode = Range("Splitcode")

For Each cell In Splitcode
ActiveWorkbook.Activate
ThisWorkbook.Sheets(cell.Value).Copy Before:=Workbooks.Add.Sheets(1)
Application.ActiveWorkbook.SaveAs Filename:=Path & "\" & "Timecard-" & cell.Value, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
Next cell

For Each email In Sheets("EmailAddress").Range("B2:B5")
    Set OutMail = OutApp.CreateItem(0)
         With OutMail
            .To = email.Value
            .Subject = Cells(email.Row, "D").Value
            .Body = "Hi " & Cells(email.Row, "C").Value & "," _
                  & vbNewLine & vbNewLine & _
                    "Please review the attached timecard and let me know if approved." _
                  & vbNewLine & vbNewLine & _
                    "Thanks!"
            .Attachments.Add (Path & "\" & Cells(email.Row, "D").Value)
            '.Send
            .Save
        End With
Next email

End Sub

None 我可以在网上找到的其他解决方案似乎与这个特定问题相关。

Answer 1

BigBen 帮我解决了这个问题。问题是工作簿和 sheet 在 Cells 调用之前不合格。这是工作代码：

Sub SaveAndSend()

Dim Splitcode As Range
Dim Path As String
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim email As Range
Path = Application.ActiveWorkbook.Path
Set OutApp = CreateObject("Outlook.Application")
Set Splitcode = Range("Splitcode")

For Each cell In Splitcode
ActiveWorkbook.Activate
ThisWorkbook.Sheets(cell.Value).Copy Before:=Workbooks.Add.Sheets(1)
Application.ActiveWorkbook.SaveAs Filename:=Path & "\" & "Timecard-" & cell.Value, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
Next cell

For Each email In Sheets("EmailAddress").Range("B2:B5")
    Set OutMail = OutApp.CreateItem(0)
         With OutMail
            .To = email.Value
            .Subject = Cells(email.Row, "D").Value
            .Body = "Hi " & Cells(email.Row, "C").Value & "," _
                  & vbNewLine & vbNewLine & _
                    "Please review the attached timecard and let me know if approved." _
                  & vbNewLine & vbNewLine & _
                    "Thanks!"
            .Attachments.Add Path & "\" & ThisWorkbook.Worksheets("EmailAddress").Cells(email.Row, "D").Value
            '.Send
            .Save
        End With
Next email


End Sub

谢谢大家！

VBA - 运行-时间错误'-2147024894 (80070002)'

VBA - run-time error '-2147024894 (80070002)'

excel

runtime-error

email-attachments