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

Question

I am trying this method to save separate sheets from one workbook as files and send those files as attachments in separate emails.

It's saving the files fine, but when it tries to email I get this "run-time error '-2147024894 (80070002)': Cannot find this file. Verify the path and file name are correct." Unfortunately I've been stuck on this error for a long time - any suggestions will be greatly appreciated!

I have named the Splitcode range and that is working because the files go into the ActiveWorkbook folder. I have the attachment names in column D of that sheet, exactly how they appear in the file. (see screenshot - EmailAddress tab w/ Splitcode)

The ActiveWorkbook folder contains only the active workbook, until the macro is run and the files (Timecard-E1.xlsm , etc.) appear in there.

Here is the code:

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 of the other solutions I can find on line appear to be relevant to this specific problem.

Answer 1

BigBen helped me solve this. The issue was that the workbook and sheet were not qualified before the Cells call. Here is the working code:

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

Thanks everyone!