Unable to Send E-mails, run-time error 1004

Question

While running this code i get run-time error 1004, "Application-defined object defined error". This error is showing up on the line starting with "NumRows = Worksheets("Data")" in the first function. Can someone just check on this code and let me know what's wrong here, i am new to VBA macros with limited knowledge.

Public Sub loopCheck()
Dim NumRows As Integer
Dim eID As String
Dim eName As String
Dim eEmail As String
Dim supportGroup As String
Dim managerEmail As String
Dim acName As String

Dim x As Integer
      Application.ScreenUpdating = False
      NumRows = Worksheets("Data").Range("A5", Range("A5").End(xlDown)).Rows.Count  ' Set numrows = number of rows of data.
      Worksheets("Data").Range("A5").Select ' Select first record.

      For x = 1 To NumRows  ' Establish "For" loop to loop "numrows" number of times.

        eID = Worksheets("Data").Range("A" & x + 4).Value
        eName = Worksheets("Data").Range("B" & x + 4).Value
        eEmail = Worksheets("Data").Range("C" & x + 4).Value
        supportGroup = Worksheets("Data").Range("F" & x + 4).Value
        managerEmail = Worksheets("Data").Range("G" & x + 4).Value
        acName = Worksheets("Data").Range("I" & x + 4).Value


        'Prepare table to be sent locally.
        Worksheets("Data").Range("AA5").Value = eID
        Worksheets("Data").Range("AB5").Value = eName
        Worksheets("Data").Range("AC5").Value = eEmail
        Worksheets("Data").Range("AF5").Value = supportGroup

        managerEmail = managerEmail + ";" + Worksheets("Data").Range("AA1").Value

        'Call Emails function.
        Call Emails(acName, eEmail, managerEmail)

         ActiveCell.Offset(1, 0).Select
      Next

      Application.ScreenUpdating = True
End Sub

Public Sub Emails(x As String, y As String, z As String)

Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object

Dim a As String
Dim b As String
Dim c As String

a = y
b = z
c = x

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)

With newEmail
    .To = a
    .CC = b
    .BCC = ""
    .Subject = Worksheets("MF").Range("A1") & c
    .Body = ""
    .display

    Set xInspect = newEmail.getInspector
    Set pageEditor = xInspect.WordEditor

    Worksheets("MF").Range("A9").Copy
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

    Worksheets("MF").Range("A3").Copy
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

    Worksheets("Data").Range("AA4:AF5").Copy
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

    Worksheets("MF").Range("A5").Copy
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

    Worksheets("MF").Range("A7").Copy
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)


    .send
    Set pageEditor = Nothing
    Set xInspect = Nothing
End With

Set newEmail = Nothing
Set outlook = Nothing

End Sub

your program can be made workable with some modifications but it will still show outlook email creation display. Secondly you should set references to worksheets properly. — skkakkar
@skkakkar, below code works but sometimes i get error as : Run-time error '4605':This method or property is not available because the clipboard is empty or not valid. and ends up abruptly. It points towards second function line with "ws2.Range("A3").Copy". Getting this error when i try to run it for more number of records and it happens only for some instances and not every time i run it. — chris
please look into adding some wait time in the program like Application.Wait (Now + TimeValue("0:00:10")) and see whether it helps or not. I shall further look into it and inform you after review of your error number related matter. — skkakkar
adding a wait timer helped , i added it before copying data each time. Just wanted to understand why i was getting this error @skkakkar — chris
While debugging your original program frequent errors with different numbers came up which I consider due to improper workbook and worksheet references. But in this case I feel outlook instance has to be active to send emails. Our program sets outlook to nothing and these programs do require some time to open their instances. Perhaps this could be the reason behind such errors . Error instances may change from time to time on different lines depending upon syncronization of program execution and outlook active stage. — skkakkar

skkakkar skkakkar · Accepted Answer · 2019-02-09T11:35:15

I have made some corrections in your code and it works at my end . Please try this. Mainly it relates to setting workbook and worksheets references properly otherwise your code seems to be okay:

Public Sub loopCheck()
Dim NumRows As Integer
Dim eID As String
Dim eName As String
Dim eEmail As String
Dim supportGroup As String
Dim managerEmail As String
Dim acName As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim x As Integer

    Set ws1 = ThisWorkbook.Worksheets("Data") ' Set workbook & worksheet reference 
    Set ws2 = ThisWorkbook.Worksheets("MF")  '' Set workbook & worksheet reference 
    NumRows = ws1.Range("A5", Range("A5").End(xlDown)).Rows.Count ' Set numrows = number of rows of data.
     ws1.Range("A5").Select ' Select first record.

      For x = 1 To NumRows  ' Establish "For" loop to loop "numrows" number of times.

        eID = ws1.Range("A" & x + 4).Value
        eName = ws1.Range("B" & x + 4).Value
        eEmail = ws1.Range("C" & x + 4).Value
        supportGroup = ws1.Range("F" & x + 4).Value
        managerEmail = ws1.Range("G" & x + 4).Value
        acName = ws1.Range("I" & x + 4).Value


        'Prepare table to be sent locally.
    With ws1
        .Range("AA5").Value = eID
        .Range("AB5").Value = eName
        .Range("AC5").Value = eEmail
        .Range("AF5").Value = supportGroup

        managerEmail = managerEmail + ";" + ws1.Range("AA1").Value

        'Call Emails function.
        Call Emails(acName, eEmail, managerEmail)

         ActiveCell.Offset(1, 0).Select

    End With
      Next
      Application.ScreenUpdating = True
End Sub

Public Sub Emails(x As String, y As String, z As String)

Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object

Dim a As String
Dim b As String
Dim c As String
Dim str As String
With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

a = y
b = z
c = x

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
Set ws2 = ThisWorkbook.Worksheets("MF")
str = ws2.Range("A1").Value & c

With newEmail
    .To = a
    .CC = b
    .BCC = ""
    .Subject = str
    .Body = ""
    .Display

    Set xInspect = newEmail.GetInspector
    Set pageEditor = xInspect.WordEditor

   Set ws1 = ThisWorkbook.Worksheets("Data")

    ws2.Range("A9").Copy
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

   ws2.Range("A3").Copy
    pageEditor.Application.Selection.Paste xlValuesAndFormat (wdFormatPlainText)

   ws1.Range("AA4:AF5").Copy
    pageEditor.Application.Selection.Paste xlValuesAndFormat (wdFormatPlainText)

    ws2.Range("A5").Copy
    pageEditor.Application.Selection.Paste xlValuesAndFormat (wdFormatPlainText)

    ws2.Range("A7").Copy
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)


    .Send
    Set pageEditor = Nothing
    Set xInspect = Nothing
End With

Set newEmail = Nothing
Set outlook = Nothing
With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Unable to Send E-mails, run-time error 1004

2 Answers