E-Mail Using Excel VBA & Outlook Error

Hi,

I have set up a code to send E-mail using Outlook & Excel VBA. The Code is as below -

Sub SendEMail()

    Dim OLApp As Outlook.Application
    Dim OLEMail As Outlook.MailItem
    Dim Adressbook As Worksheet, MailTo As String, Code As String, Counter As Integer, LR As Integer, Path As String
    
    
    Set OLApp = New Outlook.Application
    Set OLEMail = OLApp.CreateItem(olMailItem)
    Set Adressbook = ThisWorkbook.Worksheets("Adress Book")

    LR = Adressbook.Cells(Rows.Count, "A").End(xlUp).Row
    
    For Counter = 2 To LR
    
    MailTo = Adressbook.Cells(Counter, "C").Value
    Code = Adressbook.Cells(Counter, "A").Value
    Path = "C:\Users\J\Desktop\Send Dispatch Details\Attachments\" & Code & ".xlsm"
    
        If MailTo <> "" Or MailTo = Null Then
            'On Error GoTo Jumper
            With OLEMail
                .Display
                .BodyFormat = olFormatPlain
                .To = MailTo
                .Subject = "ZFI/" & Code & " - Dispatch Details"
                .Attachments.Add Path
                .Send                
            End With
        End If
        
'Jumper:
    Next Counter
    
    Set OLApp = Nothing
    Set OLEMail = Nothing
    Set Adressbook = Nothing
    
MsgBox "Dispatch Details E-Mailed!", vbOKOnly, "E-Mail"
    
End Sub

The Code Runs OK the 1st time, however during the second time it gives me the following error -

Run-time error '462': The remote server machine does not exist or is unavailable

Can anyone guide me how I can get rid of this?

Helpful Links -

http://support.microsoft.com/kb/189618

http://support.microsoft.com/kb/178510

Hi!

Thank you for the reply.

However, the code ran for the 1st time well.. After that I am again getting error.

Error - Runtime Error 2147023170 (800706be): Automation Error TheRemoteProcedureCallFailed

Unable to figure out why.

Can you please help?

Cheers,

Deep

Hi msexcelathome,

I think excel address referencing is the issue(reference to Excel has been created and has not been released).

Try to change your code:

Like

Set Adressbook = ThisWorkbook.Worksheets("Adress Book")

To

Set Adressbook = ThisWorkbook.Sheets("Adress Book")

And,

MailTo = Adressbook.Cells(Counter, "C").Value

To

MailTo = Adressbook.Cells(Counter, 3).Value

And check similar lines of code. Hope this will help you.



Regards,
Paresh J

Hi!

I figured it out on my own somehow.

Thank you for the help anyway..

Reputation Added!