VBA-运行时错误'-214702489480070002'

问题描述

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

它可以很好地保存文件，但是当尝试发送电子邮件时，我收到此“运行时错误'-2147024894（80070002）'：找不到此文件。请验证路径和文件名是否正确。”不幸的是，我一直在这个错误上停留很长时间-任何建议将不胜感激！

我已经命名了Splitcode范围，并且可以正常工作，因为文件进入了ActiveWorkbook文件夹。我在工作表的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

我在网上找不到的其他解决方案似乎都与此特定问题有关。

解决方法

BigBen帮助我解决了这个问题。问题在于工作簿和工作表在单元调用之前没有资格。这是工作代码：

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

谢谢大家！