0

I have Excel VBA code in my spreadsheet that takes a list of names and email addresses, creates a PowerPoint certificate and emails each person their certificate.

I can add a logo to the end of the email if I give it a specific path such as

C:\Users\User\Desktop\Folder\img.png

but if I say

ActiveWorkbook.Path & '\img.png'

it inserts an empty box.

Public Function generateCerts()
    Dim CurrentFolder As String
    Dim fileName As String
    Dim myPath As String
    Dim UniqueName As Boolean
    Dim sh As Worksheet

    Dim myPresentation As PowerPoint.Presentation
    Dim PowerPointApp As PowerPoint.Application
    Dim shp As PowerPoint.Shape

    Dim outlookApp As Outlook.Application
    Dim myMail As Outlook.MailItem

    Set outlookApp = New Outlook.Application

    Set PowerPointApp = CreateObject("PowerPoint.Application")
    Set myPresentation = PowerPointApp.Presentations.Open(ActiveWorkbook.Path & "\Certificate3.pptx")
    
    Set shp = myPresentation.Slides(1).Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=0, Top:=250, Width:=825, Height:=68)
    shp.TextFrame.TextRange.Font.Size = 36
    shp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
    
    Set sh = Sheets("CertNames")
    For Each rw In sh.Rows
        If rw.Row > 1 Then
            If sh.Cells(rw.Row, 1).Value = "" Then
                Exit For
            End If
        
            shp.TextFrame.TextRange.Text = sh.Cells(rw.Row, 1) & " " & sh.Cells(rw.Row, 2).Value & " " & sh.Cells(rw.Row, 3).Value
    
            fileName = ActiveWorkbook.Path & "\" & sh.Cells(rw.Row, 2).Value & " " & sh.Cells(rw.Row, 3).Value & " " & rw.Row & ".pdf"
            myPresentation.ExportAsFixedFormat fileName, _
                ppFixedFormatTypePDF, ppFixedFormatIntentPrint, msoCTrue, ppPrintHandoutHorizontalFirst, _
                ppPrintOutputSlides, msoFalse, , ppPrintAll, , False, False, False, False, False
                
            Set myMail = outlookApp.CreateItem(olMailItem)
            myMail.Attachments.Add fileName
            
            myMail.SentOnBehalfOfName = ""
'            myMail.BCC = ""
            myMail.To = sh.Cells(rw.Row, 4).Value
            myMail.Subject = "Thank you for attending"
            myMail.HTMLBody = "Hello" & " " & sh.Cells(rw.Row, 1).Value & ","
            myMail.HTMLBody = myMail.HTMLBody & "<p>Thank you for participating in <b><i>Session 7
            myMail.HTMLBody = myMail.HTMLBody & "<p>Support</p>"
            myMail.HTMLBody = myMail.HTMLBody & "<img src='ActiveWorkbook.Path & '\img.png''"
            myMail.Display
'            myMail.Send
            
        End If
    Next rw

    myPresentation.Saved = True
    PowerPointApp.Quit
    
End Function
Community
  • 1
  • 1
kemosabe
  • 146
  • 13

1 Answers1

1

Declare the path as a string so you can inspect it:

Dim imagePath As String
imagePath = ActiveWorkbook.Path & "\img.png"

Now that you know it's correct, use it like this:

myMail.HTMLBody = myMail.HTMLBody & "<img src='" & imagePath & "'>"
HackSlash
  • 4,944
  • 2
  • 18
  • 44