macro..create pdf: would like email window visible (on top of excel)

[repairman615]

Many thanks to this site and especially all the great people here!

I have a macro that creates a pdf, then attaches the pdf to a email.
Thanks Ron de Bruin!

The macro works. There is one part that I would like to improve if possible. After the pdf gets attached into a email, this email window is behind excel (in the background).

Is there a way to have this window open on top of excel in the foreground?

The create/mail pdf macro.

Sub RDB_Worksheet_Or_Worksheets_To_PDF()
'
'   keyboard shortcut   ctrl shift p
'
'
    Dim FileName As String
    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "be aware that every selected sheet will be published"
    End If
    'Call the function with the correct arguments
    'Tip: You can also use Sheets("Sheet3") instead of ActiveSheet in the code(sheet not have to be active then)
    FileName = RDB_Create_PDF(ActiveSheet, "", True, False)
    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)
 
    If FileName <> "" Then
        'Ok, you find the PDF where you saved it
        'You can call the mail macro here if you want
        If MsgBox("Would You Like to Mail the Worksheet?", vbQuestion + vbYesNo) = vbNo Then
             Exit Sub
                Else
      ' RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "This is the subject", _
                   "See the attached PDF file with the last figures" _
                   & vbNewLine & vbNewLine & "Regards Ron de bruin", False
 
            RDB_Mail_PDF_Outlook FileName, "[EMAIL="anemailadress@yourmail.com"]anemailadress@yourmail.com[/EMAIL]", "Globdyne", _
             "Please See the Attached PDF File." _
             & vbNewLine & vbNewLine & "   Thank You," & vbNewLine & "       Owner", False
        End If
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub

the create pdf function

Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant
    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")
            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If
        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If
        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0
        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function

the email function

Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrSubject As String, StrBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = StrTo
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

 

[daverunt]

The '.display' can be used to display the message before .send. Not just when there is an error. Display forces it to come into focus.
However it may be very quick so you could add a timer to the mail send too so you can view it before it goes.

.display
Application.Wait (Now + TimeValue("0:00:05"))
.send

 

[repairman615]

Many thanks to you daverunt.

I did not change anything in the code, and now it is opening in the forground and working as I would like.

If it happens again I will try your suggestion.

Thank You.