Consulting

Results 1 to 2 of 2

Thread: Excel VBA attaching print area as PDF

  1. #1
    VBAX Regular
    Joined
    Jul 2018
    Posts
    20
    Location

    Excel VBA attaching print area as PDF

    Hey, I'm trying to create a macro whereby the print area of a sheet, "Hotel Booking" is attached as a PDF file to an email. The email will be created using CDO and not Outlook Application. Everything else in my code works except for the attachment. It will say file not found and will not attach anything to the email.

    Here's my code:

    Sub CDO_Mail_Small_Text2()    Dim iMsg As Object
        Dim iConf As Object
        Dim strbody As String
        Dim Flds As Variant
        Dim PDFfile As String, Title As String
        Dim printRange As Range
        Dim i As Long
        
    CarryOn = MsgBox("Proceed to compose Email?", vbYesNo, "Continue?")
    
    
    If CarryOn = vbYes Then
    
    
        Set iMsg = CreateObject("CDO.Message")
        Set iConf = CreateObject("CDO.Configuration")
    
    
            iConf.Load -1    ' CDO Source Defaults
            Set Flds = iConf.Fields
            
            
    Title = Sheets("Hotel Booking").Range("AF17")
    PDFfile = ActiveWorkbook.FullName
      i = InStrRev(PDFfile, ".")
      If i > 1 Then PDFfile = Left(PDFfile, i - 1)
      PDFfile = PDFfile & "_" & Sheets("Hotel Booking").Name & ".pdf"
      
    Set printRange = Range(Sheets("Hotel Booking").PageSetup.PrintArea)
    
    
             
    With Sheets("Hotel Booking")
        printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      End With
    
    
    
    
            With Flds
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-mail.outlook.com"
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxx@outlook.com"
                .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxx"
                .Update
            End With
    
    
        With iMsg
            Set .Configuration = iConf
            .To = "xxxxx@gmail.com"
            .CC = ""
            .BCC = ""
            .From = " <xxxx@outlook.com>"
            .Subject = " "
            .TextBody = " "
            .AddAttachment PdfFile
            .Send
        End With
        
    'Kill PdfFile
    
    
        Set iMsg = Nothing
        Set iConf = Nothing
        Set Flds = Nothing
        
        If Err.Number <> 0 Then
         MsgBox "There was an error"
         Exit Sub
         
        Else
         MsgBox "Email has been sent!"
         
        End If  'for error
        
    End If   'compose email
    
    
    End Sub

  2. #2
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    Sub CDO_Mail_Small_Text()    Dim iMsg As Object
        Dim iConf As Object
        Dim strbody As String
        Dim Flds As Variant
    
        Set iMsg = CreateObject("CDO.Message")
        Set iConf = CreateObject("CDO.Configuration")
    
        '    iConf.Load -1    ' CDO Source Defaults
        '    Set Flds = iConf.Fields
        '    With Flds
        '        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
        '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        '        .Update
        '    End With
    
        strbody = "Hi there" & vbNewLine & vbNewLine & _
            "This is line 1" & vbNewLine & _
            "This is line 2" & vbNewLine & _
            "This is line 3" & vbNewLine & _
            "This is line 4"
    
        With iMsg
            Set .Configuration = iConf
            .To = "ron@debruin.nl"
            .CC = ""
            .BCC = ""
            .From = """Ron"" <ron@something.nl>"
            .Subject = "Important message"
            .TextBody = strbody
            .Send
        End With
    
        Set iMsg = Nothing
        Set iConf = Nothing
        Set Flds = Nothing
    End SubNote: If you get this error : The transport failed to connect to the server
    
    then try to change the SMTP port from 25 to 465
    Peace of mind is found in some of the strangest places.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •