VBA email loop works on my computer but not a colleagues

[picklechips]

Hi all,

I have a macro that creates multiple outlook emails from a list of email addresses, attaches pdf's and a powerpoint picture in the email body and sends. (see below)

The macro works perfect on my computer, however on my colleague's it only sends the first email then an error appears before sending the next email (ERROR: INVALID PROCEDURE CALL OR ARGUMENT)


Ive been trying to figure it out but no idea why it would work for the first email then bug out on the 2nd when it works fine for me.

Thanks in advance!
Pickles

Option Explicit


Sub Emailmacro()
Dim TempFile As String
    Dim SigString As String
    Dim SigName As String
    Dim Signature As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailTo As String
    Dim Ratesheetpdf As Variant
    Dim Brochurepdf As Variant
    Dim subj As String
    Dim body As String
    Dim LastRw As Long
    Dim i As Integer
    Dim wb As Workbook
    
    Set wb = ThisWorkbook
    
 On Error GoTo ErrorHandler




    'Ratesheet pdf attachment
    MsgBox ("SELECT RATESHEET PDF - EMAIL ATTACHMENT")
    Ratesheetpdf = Application.GetOpenFilename("PDF Files (*.pdf), *.pdf")
    
    MsgBox ("SELECT BROCHURE PDF - EMAIL ATTACHMENT")
    Brochurepdf = Application.GetOpenFilename("PDF Files (*.pdf), *.pdf")
    
    'ppt slide attachment
    MsgBox ("SELECT POWERPOINT FILE - EMAIL BODY")
    Dim strFileName As String
    
    strFileName = Application.GetOpenFilename( _
        FileFilter:="PowerPoint Files (*.pptx), *.pptx", _
        Title:="Open", _
        ButtonText:="Open")
        
    If strFileName = "False" Then Exit Sub
    
    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPres = pptApp.Presentations.Open(strFileName)
    Set pptSlide = pptPres.Slides(1)
    Set OutApp = CreateObject("Outlook.Application")
    
    'Get the text that will go on the email subject
    subj = Sheets(1).Range("f2")




    wb.Activate
    


    
    'Assign the file name for the temporary image file of the PowerPoint slide
    TempFile = "temp.jpg"
    
    'Export slide from PowerPoint presentation to temporary file
    pptSlide.Export Filename:=Environ("temp") & "\" & TempFile, FilterName:="JPG"
   
    'Create email loop
    LastRw = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 2 To LastRw Step 100




        EmailTo = Join(Application.Transpose(Sheets(1).Range("A" & i & ":A" & WorksheetFunction.Min(i + 99, LastRw)).Value), ";")
    
       Set OutMail = OutApp.CreateItem(0)
      Set OutMail.SendUsingAccount = Session.Accounts.Item(5)
       
       With OutMail
            .Display
            .To = ""
            .CC = ""
            .BCC = EmailTo
            .Subject = subj
            .body = ""
            .SendUsingAccount = OutApp.Session.Accounts.Item(5)
            .Attachments.Add Environ("temp") & "\" & TempFile
            .HTMLBody = "<img src=""cid:" & TempFile & """ width=""150%"">"
            .HTMLBody = .HTMLBody
            .Attachments.Add Ratesheetpdf
            .Attachments.Add Brochurepdf
            .Send
             End With
  
    Next i
    On Error GoTo 0
    
    'Delete the temporary image file of the PowerPoint slide
    Kill Environ("temp") & "\" & TempFile




    pptPres.Close
    pptApp.Quit
    Set pptApp = Nothing
    Set pptPres = Nothing
    Set pptSlide = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing




Exit Sub




ErrorHandler:
pptPres.Close
pptApp.Quit
MsgBox "Error:" & vbNewLine & vbNewLine & Err.Description & Err.Number & Err.Source & Err.HelpFile & Err.HelpContext
OutMail.Close 1




End Sub

 

[AlphaFrog]

Comment out the On Error GoTo ErrorHandler line, and run the code. Report back what line of code the debugger highlights.

 

[Kamolga]

To run email from excel, they need to open vba then tools/references.../outlook object library.

Because I could not get all my users (office 365) to do that, I use this

Sub ObjectLivraryActivation()  
On Error Resume Next
    'Activate Outlook 16.0 object library
      ThisWorkbook.VBProject.References.AddFromGuid _
        GUID:="{00062FFF-0000-0000-C000-000000000046}", _
        Major:=0, Minor:=0 'Use zeroes to default to latest version
  On Error GoTo 0
End Sub

I got the file thanks to

 Sub ObjectLibraries() 'Those are the object libraries present on this computer
 'Need to go in macro settings and trust access to projet object model
 Dim ref As Variant
 For Each ref In ThisWorkbook.VBProject.References
    Debug.Print "Reference Name: ", ref.Name
    Debug.Print "Path: ", ref.FullPath
    Debug.Print "GUID: " & ref.GUID
    Debug.Print "Version: " & ref.Major & "." & ref.Minor
    Debug.Print " "
  Next ref
 End Sub

 

[picklechips]

Thank you both for responding! The added code from Kamolga seemed to have done the trick

I did previously try adding in the object library to my colleague's excel but perhaps it was the wrong one as there are so many to chose from.


THanks again!
Pickles

 

[Kamolga]

You are welcome. Thank you for the feedback.