• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

PDF - Email by VBA

masb

New Member
Hi everyone,

I'm new to the forum, really impressed with your conversation and learnt a lot. I'm stuck with one of the equation in VBA and I wonder if someone can please guide me.

I'm using this following code to attach items via VBA as well as convert the current worksheet to PDF and attach in the same email. However, it converts the worksheet to pdf but doesn't attach it in the email. Please can someone take a look and provide me the guidance.

Code:
Private Sub CommandButton1_Click()
    Dim xStrFile As String
    Dim xFilePath As String
    Dim xFileDlg As FileDialog
    Dim xFileDlgItem As Variant
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    Dim IsCreated As Boolean
    Dim i As Long
    Dim PdfFile As String, Title As String
    Dim OutlApp As Object
  
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailOut = xOutApp.CreateItem(olMailItem)
    Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
    If xFileDlg.Show = -1 Then
         
       
On Error Resume Next
  Set OutlApp = GetObject("Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

 
    PdfFile = ActiveWorkbook.FullName
      i = InStrRev(PdfFile, ".")
    If i > 1 Then PdfFile = Left(PdfFile, i - 1)
    PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
    With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
      
       
CarryOn = MsgBox("Are you sure ?", vbYesNo, "Confirmation")
If CarryOn = vbYes Then
End If
 
        With xMailOut
            .BodyFormat = olFormatRichText
            .To = "test@test.com"
            .Subject = "test"
            .HTMLBody = "test"
            For Each xFileDlgItem In xFileDlg.SelectedItems
                .Attachments.Add xFileDlgItem
                Next xFileDlgItem
                .Display

        End With
    End If
    Set xMailOut = Nothing
    Set xOutApp = Nothing
  
   
    Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:
Like this?

Code:
Sub mailpdf()
    Dim annex As String
    Dim OutApp As Object
    Dim OutMail As Object
    annex = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=annex
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "test@test.com"
        .Subject = "test"
        .Body = "test"
        .Attachments.Add annex
        .Display 'Or .Send
    End With
End Sub
 
Back
Top