Save document as pdf and attach to new mail

Hy,
I have a macro that creates a new mail which works. Here is the macro.

Code:

---

Dim olApp      As Object
    Dim strAnrede  As String
    Dim strName    As String
    Dim strFntClr  As String
    Dim strFntNme  As String
    Dim strFntWht  As String
    Dim strFntSiz  As String
    Dim strFntStl  As String
    Dim strFntUdl  As String
    Dim sMyString1 As String    'T1
    Dim sMyString2 As String    'T2
    Dim sMyString3 As String    'T3
    Dim sMyString4 As String    'T4
    Dim sMyString5 As String    'T5
    Dim sMyString6 As String    'T6
    Dim sMyString7 As String    'T7
    Dim sMyString8 As String    'T8
    sMyString1 = ActiveDocument.Bookmarks("T1").Range.Text
    sMyString2 = ActiveDocument.Bookmarks("T2").Range.Text
    sMyString3 = ActiveDocument.Bookmarks("T3").Range.Text
    sMyString4 = ActiveDocument.Bookmarks("T4").Range.Text
    sMyString5 = ActiveDocument.Bookmarks("T5").Range.Text
    sMyString6 = ActiveDocument.Bookmarks("T6").Range.Text
    sMyString7 = ActiveDocument.Bookmarks("T7").Range.Text
    sMyString8 = ActiveDocument.Bookmarks("T8").Range.Text
         
        Set olApp = CreateObject("Outlook.Application")
            With olApp.CreateItem(0)
                .To = sMyString1
                .Subject = "text " & sMyString8
                .HTMLBody = sMyString7 & " " & sMyString4 & "<span style='color:" & strFntClr & "; " & _
                            "font-family:" & strFntNme & "; font-size:" & strFntSiz & _
                            "pt; font-weight:" & strFntWht & "; font-style:" & strFntStl & _
                            ",'>" & strName & "</span>,<br><br>" & _
                            "text " & sMyString8 & " zu senden." & "<br><br>" & _
                            "text" & "<br><br>" & _
                            "Kind Regards" & "<br><br>" & _
                            "Ttext" & "<br>"

                    .Display
                End With
           

End Sub

Public Function FarbeInHtml(ByVal lngRGB As Long) As String
FarbeInHtml = Right$("000000" & Hex$(lngRGB), 6)
FarbeInHtml = "#" & Right$(FarbeInHtml, 2) & Mid$(FarbeInHtml, 3, 2) & Left$(FarbeInHtml, 2)
End Function

---

The Word document has a macro that saves the .docm file as a .docx file. Here is the macro:

Code:

---

Dim firstName, lastName As String
firstName = ActiveDocument.Bookmarks("T7").Range.Text
lastName = ActiveDocument.Bookmarks("T8").Range.Text

Dim pfad As String
pfad = ActiveDocument.Path & Application.PathSeparator & "Data" & Application.PathSeparator

    ChangeFileOpenDirectory pfad
    ActiveDocument.SaveAs2 FileName:= _
        "firstName.docx", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15
End Sub

---

This works also fine.
Now I want to save the new .docx file as a PDF with the same name in the same folder as the .docx file and attach the PDF to the created mail.
I searched and tried a lot, but I had no luck.

Can you help me please?
Thanks a lot.
Kind Regards

https://www.thespreadsheetguru.com/t...in-same-folder

https://docs.microsoft.com/en-us/off...ttachments.add

Thanks for your ansert.
Creating a pdf works now.
But the code with the Mail attachments does not work.

Code:

---

Dim myItem As Outlook.MailItem
    Dim myAttachments As Outlook.Attachments
   
    Set myItem = Application.CreateItem(olApp)
    Set myAttachments = myItem.Attachments
    Set myItem = Application.CreateItem(olApp)
    Set myAttachments = myItem.Attachments
   
    Dim myPath As String
    Dim CurrentFolder As String

---

I got an error: method or object not found

Set myItem = Application.CreateItem(olApp)

What made i wrong?
Thanks

This works now...

Code:

---

Dim myItem As Outlook.MailItem
   
    Set myItem = Outlook.CreateItem(olMailItem)
   
    Dim myPath As String
    Dim CurrentFolder As String

---

But there is an error on the following code:

myItem.Add "CurrentFolder\File1.pdf"
myItem.Display

I tried a lot of things but it still does not work. :banghead:
I have this code now:

Code:

---

Dim olApp      As Object
    Dim strAnrede  As String
    Dim strName    As String
    Dim strFntClr  As String
    Dim strFntNme  As String
    Dim strFntWht  As String
    Dim strFntSiz  As String
    Dim strFntStl  As String
    Dim strFntUdl  As String
    Dim sMyString1 As String    'T1
    Dim sMyString2 As String    'T2
    Dim sMyString3 As String    'T3
    Dim sMyString4 As String    'T4
    Dim sMyString5 As String    'T5
    Dim sMyString6 As String    'T6
    Dim sMyString7 As String    'T7
    Dim sMyString8 As String    'T8
    sMyString1 = ActiveDocument.Bookmarks("T1").Range.Text
    sMyString2 = ActiveDocument.Bookmarks("T2").Range.Text
    sMyString3 = ActiveDocument.Bookmarks("T3").Range.Text
    sMyString4 = ActiveDocument.Bookmarks("T4").Range.Text
    sMyString5 = ActiveDocument.Bookmarks("T5").Range.Text
    sMyString6 = ActiveDocument.Bookmarks("T6").Range.Text
    sMyString7 = ActiveDocument.Bookmarks("T7").Range.Text
    sMyString8 = ActiveDocument.Bookmarks("T8").Range.Text
   
    '*_*_* MAIL*_*_*_
    Dim myItem As Outlook.MailItem
   
    Set myItem = Outlook.CreateItem(olMailItem)
   
    Dim myPath As String
    Dim CurrentFolder As String
   
    myPath = ActiveDocument.FullName & Application.PathSeparator & "Rechnungen" & Application.PathSeparator
    CurrentFolder = ActiveDocument.Path & Application.PathSeparator & "Rechnungen" & Application.PathSeparator
    '*_*_* MAIL*_*_*_
       
        Set olApp = CreateObject("Outlook.Application")
            With olApp.CreateItem(0)
                .To = sMyString1
                .Subject = "Rechnung " & sMyString8
                .HTMLBody = sMyString7 & " " & sMyString4 & "<span style='color:" & strFntClr & "; " & _
                            "font-family:" & strFntNme & "; font-size:" & strFntSiz & _
                            "pt; font-weight:" & strFntWht & "; font-style:" & strFntStl & _
                            ",'>" & strName & "</span>,<br><br>" & _
                            "Ich erlaube mir, Ihnen die Rechnung " & sMyString8 & " zu senden." & "<br><br>" & _
                            "Ich bitte um Überweisung auf das untenstehende Konto." & "<br><br>" & _
                            "Mit freundlichen Grüßen" & "<br><br>" & _
                            "Teresa Santer BA MA" & "<br>"

                myItem.Attachments.Add CurrentFolder & Application.PathSeparator & "Rechnungen.pdf"
                myItem.Display
                   
            .Display
        End With

---

But now I get 2 Mails. The first contains all the informations (Adress, Text....)
And the second Mail contains the pdf file only.
Can you please help me again?

Thanks a lot.
Kind Regards

I always create the objects in the correct order?
Outlook object
outlook email
Any attachments
Send or display

So do not use myitem and use all the code within the With olApp.CreateItem block?

However still better to get the logic in order correctly? and understand it as well. Too many people just cobble code together with little clue as to how it works? :banghead:

Where to begin? Your code has undeclared variables that don't appear to refer to anything and assorted declared variables that have no values assigned. Without the document it is not clear what the bookmarks refer to so it is not possible to establish for example what strName refers to. However we are where we are and the following should point the way.You may need to change the variables used in the message to ensure they refer to the correct bookmarks.

Programming German text in English versions of Word creates some issues that are obvious from your reproduced code in order to produce the German special characters. That may not be so with the German interface of Windows and Office, but it is something to bear in mind.

I would strongly recommend using the Outlook Word editor to edit the message (as in the code below) as it is so much easier to do so than juggle with Outlook's implementation of HTML. You just treat the message as a Word document. You do however have to start Outlook correctly or it won't work. To that end see the note at the top of the code which points to the function you can download that is called by the macro below.

The code here also inserts the default signature associated with the sending account, so you may need to adjust the message body to accommodate that.

Finally I would not recommend the use of bookmarks to set the variable texts. Bookmarks are notoriously easy for users to overwrite and that will cause problems. I strongly urge you to use content controls instead. These can be locked against deletion and can be given meaningful titles for ease of access. See https://www.gmayor.com/insert_content_control_addin.htm

Code:

---

Option Explicit

'Graham Mayor - http://www.gmayor.com - Last updated - 13/11/2020

'Requires the code from - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.

Private Sub Send_As_Mail()
Dim olApp As Object
Dim olInsp As Object
Dim oItem As Object
Dim wdDoc As Document
Dim oRng As Range
Dim bStarted As Boolean
Dim oDoc As Document
Dim strDocName As String
Dim strPath As String
Dim intPos As Integer
Dim sMyString1 As String
Dim sMyString2 As String
Dim sMyString3 As String
Dim sMyString4 As String
Dim sMyString5 As String
Dim sMyString6 As String
Dim sMyString7 As String
Dim sMyString8 As String

    Set oDoc = ActiveDocument
    oDoc.Save
    If oDoc.path = "" Then
        MsgBox "Das Dokument muss zuerst gespeichert werden"
        GoTo lbl_Exit
    End If

    sMyString1 = oDoc.Bookmarks("T1").Range.Text
    sMyString2 = oDoc.Bookmarks("T2").Range.Text
    sMyString3 = oDoc.Bookmarks("T3").Range.Text
    sMyString4 = oDoc.Bookmarks("T4").Range.Text
    sMyString5 = oDoc.Bookmarks("T5").Range.Text
    sMyString6 = oDoc.Bookmarks("T6").Range.Text
    sMyString7 = oDoc.Bookmarks("T7").Range.Text
    sMyString8 = oDoc.Bookmarks("T8").Range.Text

    strDocName = oDoc.Name
    strPath = oDoc.path & "\Rechnungen\"
    intPos = InStrRev(strDocName, ".")
    strDocName = Left(strDocName, intPos - 1)
    strDocName = strPath & strDocName & ".pdf"
    oDoc.ExportAsFixedFormat OutputFileName:=strDocName, _
                            ExportFormat:=wdExportFormatPDF, _
                            OpenAfterExport:=False, _
                            OptimizeFor:=wdExportOptimizeForPrint, _
                            Range:=wdExportAllDocument, from:=1, To:=1, _
                            Item:=wdExportDocumentContent, _
                            IncludeDocProps:=True, _
                            KeepIRM:=True, _
                            CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                            DocStructureTags:=True, _
                            BitmapMissingFonts:=True, _
                            UseISO19005_1:=False
    Set olApp = OutlookApp()

    'Create a new mailitem
    Set oItem = olApp.CreateItem(0)

    With oItem
        .To = sMyString1
        .Subject = "Rechnung " & sMyString8
        .Attachments.Add strDocName
        .BodyFormat = 2        'olFormatHTML
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        .Display 'do not remove
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        oRng.Text = sMyString7 & " " & sMyString4 & sMyString5 & vbCr & vbCr & _
                    "Ich erlaube mir, Ihnen die Rechnung " & sMyString8 & " zu senden." & vbCr & vbCr & _
                    "Ich bitte um " & ChrW(220) & "berweisung auf das unten stehende Konto." & vbCr & vbCr & _
                    "Mit freundlichen Gr" & ChrW(252) & ChrW(223) & "en" & vbCr & vbCr & _
                    "Teresa Santer BA MA"
        With oRng.Paragraphs(1).Range
            .Font.Bold = True
            .Font.Size = 14
        End With
        '.Send        'restore after testing
    End With
    If bStarted Then olApp.Quit
lbl_Exit:
    Set oItem = Nothing
    Set olApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oDoc = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    Err.Clear
    GoTo lbl_Exit
End Sub

---