Ask Experts Questions for FREE Help !
Ask
    Curlyben's Avatar
    Curlyben Posts: 18,471, Reputation: 1857
    Admin & Wine Expert
     
    #1

    Feb 18, 2014, 02:01 AM
    Is this possible in ONE button
    So the last time I did any coding in Excel was with 2003 and I'm seriously rusty.
    What I'm trying to do is create a button that prints to pdf and then mails the output to an e-mail address that's specified on a different sheet.
    Or would it make more sense to save as pdf and send ?

    Any pointers would be useful..
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #2

    Feb 20, 2014, 09:35 PM
    SaveAs PDF and Email is a pretty common activity. Here's the best primer on that:

    http://www.rondebruin.nl/pdf.htm
    Curlyben's Avatar
    Curlyben Posts: 18,471, Reputation: 1857
    Admin & Wine Expert
     
    #3

    Mar 26, 2014, 05:08 AM
    Thanks JB, slowly getting there.
    I've taken bits from various sources and have this, but could really do with an experts eyes.

    Code:
    Sub AttachActiveSheetPDF_01()
      Dim IsCreated As Boolean
      Dim PdfFile As String, Title As String
      Dim OutlApp As Object
    
    
        ' notes dims
    Dim x As Integer
    Dim UserName As String
    Dim MailDbName As String
    Dim Recipient As Variant
    Dim Maildb As Object
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim stSignature As String
    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    
    
    Dim stFileName As String
      Dim vaRecipients As Variant
     
      Dim noSession As Object
      Dim noDatabase As Object
      Dim noDocument As Object
      Dim noEmbedObject As Object
      Dim noAttachment As Object
      Dim stAttachment As String
      Dim Specialfolders As Object
      
    
    
     
     
      ' Define PDF filename
      Title = "Quote for  " & Range("A1").Value
      PdfFile = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & Title & ".pdf"
     stAttachment = Specialfolders("Desktop") & "\" & Title & ".pdf"
     
      ' Export activesheet as PDF
      With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard,
    
    
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      End With
     
      
       ' Open and locate current LOTUS NOTES User
    ' For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    ' If Range("A" & x) = "Overdue" Then
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) &
    
    
    ".nsf"
    Set Maildb = Session.GetDatabase("", MailDbName)
    If Maildb.IsOpen = True Then
    Else
    Maildb.OPENMAIL
    End If
    
    
    
    
    ' Create New Mail and Address Title Handlers
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
    
    
    ' Select range of e-mail addresses
    Recipient = Worksheets("Customer Info").Range("B" & x).Value
    MailDoc.SendTo = Recipient
    MailDoc.Subject = "Your Quote"
    MailDoc.Body = "As discussed please find attached your quote" & vbCrLf & vbCrLf & stSignature
    MailDoc.SaveMessageOnSend = True
    MailDoc.PostedDate = Now()
    On Error GoTo errorhandler1
    
    
    'Create the e-mail and the attachment.
       Set noAttachment = MailDoc.CreateRichTextItem("stAttachment")
        Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
    
    
    
    
    
    
    MailDoc.SEND 0, Recipient
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    .ScreenUpdating = True
    .DisplayAlerts = True
    
    
    
    
    
    
    errorhandler1:
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    End If
    Next x
    End With
    
    
    'Release objects from memory.
      Set noEmbedObject = Nothing
      Set noAttachment = Nothing
      Set noDocument = Nothing
      Set noDatabase = Nothing
      Set noSession = Nothing
     
      MsgBox "The e-mail has successfully been created and distributed", vbInformation
     
    End Sub
    I'm currently getting a syntax error on this part:

    Code:
      ' Export activesheet as PDF
      With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard,
    
    
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      End With
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #4

    Mar 26, 2014, 11:41 PM
    When a single command is too long to fit on one line comfortably and you put it on more than one line, you must add a space and an underline as a "linefeed" to indicate the command is continued on the next line:

    Code:
      ' Export activesheet as PDF
      With ActiveSheet
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      End With

    In the posted code above there was a second instance of a single command wrapped onto multiple lines that should be one line:
    Code:
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Curlyben's Avatar
    Curlyben Posts: 18,471, Reputation: 1857
    Admin & Wine Expert
     
    #5

    Mar 27, 2014, 07:05 AM
    Cheers JB,
    Changes made.

    Had it moaning at me about missing End if, End with and End Subs, so added them to the end of the VBA, now getting Run-Time error '91 Object variable or With block variable not set.

    Here's the current code

    Code:
    Sub AttachActiveSheetPDF_01()  Dim IsCreated As Boolean
      Dim PdfFile As String, Title As String
      Dim OutlApp As Object
    
    
        ' notes dims
    Dim x As Integer
    Dim UserName As String
    Dim MailDbName As String
    Dim Recipient As Variant
    Dim Maildb As Object
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim stSignature As String
    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    
    
    Dim stFileName As String
      Dim vaRecipients As Variant
     
      Dim noSession As Object
      Dim noDatabase As Object
      Dim noDocument As Object
      Dim noEmbedObject As Object
      Dim noAttachment As Object
      Dim stAttachment As String
      Dim Specialfolders As Object
      
    
    
     
     
      ' Define PDF filename
      Title = "Quote for  " & Range("A1").Value
      PdfFile = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & Title & ".pdf"
     stAttachment = Specialfolders("Desktop") & "\" & Title & ".pdf"
     
      ' Export activesheet as PDF
    If ActiveSheet.Index < Sheets.Count Then
        Sheets(ActiveSheet.Index + 1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    
      
       ' Open and locate current LOTUS NOTES User
    ' For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    ' If Range("A" & x) = "Overdue" Then
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GetDatabase("", MailDbName)
    If Maildb.IsOpen = True Then
    Else
    Maildb.OPENMAIL
    End If
    
    
    
    
    ' Create New Mail and Address Title Handlers
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
    
    
    ' Select range of e-mail addresses
    Recipient = Worksheets("Customer Info").Range("B" & x).Value
    MailDoc.SendTo = Recipient
    MailDoc.Subject = "Your Quote"
    MailDoc.Body = "As discussed please find attached your quote" & vbCrLf & vbCrLf & stSignature
    MailDoc.SaveMessageOnSend = True
    MailDoc.PostedDate = Now()
    On Error GoTo errorhandler1
    
    
    'Create the e-mail and the attachment.
       Set noAttachment = MailDoc.CreateRichTextItem("stAttachment")
        Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
    
    
    
    
    
    
    MailDoc.SEND 0, Recipient
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    .ScreenUpdating = True
    .DisplayAlerts = True
    
    
    
    
    
    
    errorhandler1:
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    
    
    
    
    
    
    
    
    'Release objects from memory.
      Set noEmbedObject = Nothing
      Set noAttachment = Nothing
      Set noDocument = Nothing
      Set noDatabase = Nothing
      Set noSession = Nothing
     
      MsgBox "The e-mail has successfully been created and distributed", vbInformation
      End If
    End With
    End Sub
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #6

    Mar 27, 2014, 09:35 PM
    I try to keep my WITH/END WITH ranges short and easy to spot.

    I also am manic about the indentation of code to also make it inordinately easy to see where the IF and END IF parts match up.

    I was getting an error on the EMBED_ATTACHMENT, so added that variable as a constant at the top of the macro, remove that if it's unnecessary in your environment:

    Code:
    Option Explicit
    Const EMBED_ATTACHMENT As Long = 1454
    Sub AttachActiveSheetPDF_01()
    Dim IsCreated As Boolean
    Dim PdfFile As String, Title As String
    Dim OutlApp As Object
    ' notes dims
    Dim x As Integer
    Dim UserName As String
    Dim MailDbName As String
    Dim Recipient As Variant
    Dim Maildb As Object
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim stSignature As String
     
    Dim stFileName As String
    Dim vaRecipients As Variant
     
    Dim noSession As Object
    Dim noDatabase As Object
    Dim noDocument As Object
    Dim noEmbedObject As Object
    Dim noAttachment As Object
    Dim stAttachment As String
    Dim Specialfolders As Object
     
     
    With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
    End With
     
    ' Define PDF filename
      Title = "Quote for  " & Range("A1").Value
      PdfFile = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & Title & ".pdf"
      stAttachment = Specialfolders("Desktop") & "\" & Title & ".pdf"
     
      ' Export activesheet as PDF
    If ActiveSheet.Index < Sheets.Count Then
        Sheets(ActiveSheet.Index + 1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        ' Open and locate current LOTUS NOTES User
        ' For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        ' If Range("A" & x) = "Overdue" Then
        Set Session = CreateObject("Notes.NotesSession")
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        Set Maildb = Session.GetDatabase("", MailDbName)
        If Maildb.IsOpen = True Then
            'do nothing
        Else
            Maildb.OPENMAIL
        End If
        
        ' Create New Mail and Address Title Handlers
        Set MailDoc = Maildb.CREATEDOCUMENT
        MailDoc.Form = "Memo"
        stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
         
        ' Select range of e-mail addresses
        Recipient = Worksheets("Customer Info").Range("B" & x).Value
        MailDoc.SendTo = Recipient
        MailDoc.Subject = "Your Quote"
        MailDoc.Body = "As discussed please find attached your quote" & vbCrLf & vbCrLf & stSignature
        MailDoc.SaveMessageOnSend = True
        MailDoc.PostedDate = Now()
        On Error GoTo errorhandler1
        'Create the e-mail and the attachment.
        Set noAttachment = MailDoc.CreateRichTextItem("stAttachment")
        Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
        
        MailDoc.SEND 0, Recipient
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Session = Nothing
        With Application
            .ScreenUpdating = True
            .DisplayAlerts = True
        End With
         
    errorhandler1:
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Session = Nothing
        'Release objects from memory.
        Set noEmbedObject = Nothing
        Set noAttachment = Nothing
        Set noDocument = Nothing
        Set noDatabase = Nothing
        Set noSession = Nothing
         
        MsgBox "The e-mail has successfully been created and distributed", vbInformation
    End If
    
    End Sub
    Curlyben's Avatar
    Curlyben Posts: 18,471, Reputation: 1857
    Admin & Wine Expert
     
    #7

    Mar 28, 2014, 01:44 AM
    Thanks JB.

    I replaced my previous code with yours above, but still seeing a "Run-Time error '91 Object variable or With block variable not set."

    This is in Excel 2010.

    CB.zip
    I've attached my sheet.
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #8

    Mar 29, 2014, 02:14 AM
    The problem appears to be this code:

    Code:
      PdfFile = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & Title & ".pdf"
      stAttachment = Specialfolders("Desktop") & "\" & Title & ".pdf"

    The stAttachment looks like it's the same code as PdfFile, except it's missing the CreateObject reference so it's giving an error. If you fix it by adding the CreateObject reference, then it's idential to the PdfFile code, which seems like that would be wrong.
    Curlyben's Avatar
    Curlyben Posts: 18,471, Reputation: 1857
    Admin & Wine Expert
     
    #9

    Mar 31, 2014, 06:35 AM
    Changes made.
    Now getting weird error now...
    Attached Images
     
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #10

    Apr 3, 2014, 08:31 PM
    Ok, your code is hiding the error, so let's reveal it. Change this code at the end of your macro:
    Code:
        End With
     
    errorhandler1:
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Session = Nothing
        'Release objects from memory.
        Set noEmbedObject = Nothing
        Set noAttachment = Nothing
        Set noDocument = Nothing
        Set noDatabase = Nothing
        Set noSession = Nothing
     
        MsgBox "The e-mail has successfully been created and distributed", vbInformation
    End If
     
    End Sub
    To this:

    Code:
        End With
    
            MsgBox "The e-mail has successfully been created and distributed", vbInformation
    
     ExitReset:
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Session = Nothing
        'Release objects from memory.
        Set noEmbedObject = Nothing
        Set noAttachment = Nothing
        Set noDocument = Nothing
        Set noDatabase = Nothing
        Set noSession = Nothing
        Exit Sub 
    
    End If
    
    ErrorHandler1:
       MsgBox Err.Description
       Goto ExitReset
    
    End Sub
    Curlyben's Avatar
    Curlyben Posts: 18,471, Reputation: 1857
    Admin & Wine Expert
     
    #11

    Apr 8, 2014, 12:52 AM
    Slowly but slowly.
    Now seeing ""Run-Time error '1004: Application-Defined or Object defined error"
    Not highlighting the problem.

    As you already noted I have defined both STattachment and pdffile to do the same thing, in creating the pdf file.
    Would this be the cause of the problem ?

    It's creating the pdf as expected, but not doing the notes part.

    Code:
    
    Option Explicit
    Const EMBED_ATTACHMENT As Long = 1454
    Sub AttachActiveSheetPDF_01()
    Dim IsCreated As Boolean
    Dim PdfFile As String, Title As String
    Dim OutlApp As Object
    ' notes dims
    Dim x As Integer
    Dim UserName As String
    Dim MailDbName As String
    Dim Recipient As Variant
    Dim Maildb As Object
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim stSignature As String
     
    Dim stFileName As String
    Dim vaRecipients As Variant
     
    Dim noSession As Object
    Dim noDatabase As Object
    Dim noDocument As Object
    Dim noEmbedObject As Object
    Dim noAttachment As Object
    Dim stAttachment As String
    Dim Specialfolders As Object
     
     
    With Application
       .ScreenUpdating = False
       .DisplayAlerts = False
    End With
     
    ' Define PDF filename
      Title = "Quote for  " & Range("A1").Value
      PdfFile = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & Title & ".pdf"
      stAttachment = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & Title & ".pdf"
     
      ' Export activesheet as PDF
    If ActiveSheet.Index < Sheets.Count Then
        Sheets(ActiveSheet.Index + 1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        ' Open and locate current LOTUS NOTES User
        ' For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        ' If Range("A" & x) = "Overdue" Then
        Set Session = CreateObject("Notes.NotesSession")
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        Set Maildb = Session.GetDatabase("", MailDbName)
        If Maildb.IsOpen = True Then
            'do nothing
        Else
            Maildb.OPENMAIL
        End If
        
        ' Create New Mail and Address Title Handlers
        Set MailDoc = Maildb.CREATEDOCUMENT
        MailDoc.Form = "Memo"
        stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
         
        ' Select range of e-mail addresses
        Recipient = Worksheets("Customer Info").Range("B" & x).Value
        MailDoc.SendTo = Recipient
        MailDoc.Subject = "Your Quote"
        MailDoc.Body = "As discussed please find attached your quote" & vbCrLf & vbCrLf & stSignature
        MailDoc.SaveMessageOnSend = True
        MailDoc.PostedDate = Now()
        On Error GoTo ErrorHandler1
        'Create the e-mail and the attachment.
        Set noAttachment = MailDoc.CreateRichTextItem("stAttachment")
        Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
        
        MailDoc.SEND 0, Recipient
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Session = Nothing
        With Application
            .ScreenUpdating = True
            .DisplayAlerts = True
            
        End With
     
            MsgBox "The e-mail has successfully been created and distributed", vbInformation
     
    ExitReset:
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Session = Nothing
        'Release objects from memory.
        Set noEmbedObject = Nothing
        Set noAttachment = Nothing
        Set noDocument = Nothing
        Set noDatabase = Nothing
        Set noSession = Nothing
        Exit Sub
     
    End If
     
    ErrorHandler1:
       MsgBox Err.Description
       GoTo ExitReset
     
    End Sub
    Curlyben's Avatar
    Curlyben Posts: 18,471, Reputation: 1857
    Admin & Wine Expert
     
    #12

    Apr 9, 2014, 02:10 PM
    Well I think I've found that error, the attaching to Lotus Notes was causing the problem.
    Taking that out and it produces the pdf fine.

    User is ok with this as it wasn't actually all that important a part of this project, typical.

    Now I need to get this code to work correctly.

    Code:
    ' Export activesheet as PDF
    If ActiveSheet.Index < Sheets.Count Then
        Sheets(ActiveSheet.Index + 1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Now it's meant to convert the active sheet AND the following one into the same PDF
    Does the following sheet fine, but not the active one.
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #13

    Apr 11, 2014, 12:19 AM
    First you have to ADD the next sheet to the "selected sheets". Once both sheets are selected you should get the results you want.

    Code:
    'Export activesheet and next sheet to PDF
    If ActiveSheet.Index < Sheets.Count Then 
        ActiveWorkbook.Sheets(ActiveSheet.Index + 1).Select False
        ActiveSheet.Activate
    End If
        
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFile, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False

Not your question? Ask your question View similar questions

 

Question Tools Search this Question
Search this Question:

Advanced Search

Add your answer here.


Check out some similar questions!

Dryer button coneccted to washer button [ 1 Answers ]

~ someone gave me a stackable kenmore washer/dryer #134234500 0405 are the numbers on it. The dryer will not come on unless the washer is running & ~ don't know why? I can't afford repairs so I am trying to get it going myself. Any advice would be great?

Overdrive button [ 4 Answers ]

I need to know should the overdrive button be pushed off or left alone when you are in city traffic or on the highway? I think I may have this confused. I thought it was suppose to be pushed in for off for city driving, but my Dakota feels like it is 'holding' back with it on the off position. ...

Press sleep button and switch on/off button to be able to see login screen [ 1 Answers ]

Friend of mine has got problem with his new desktop (XP SP2) , when he starts the PC it boots normally till it reaches where it shows windows XP logo then the screen gets blank (i.e he can not see the login name for users). What he used to do: is press the sleep button on the keyboard, then...

The browse button [ 1 Answers ]

Hello I am doing an application in VB.NET whereby I have to back up my database. On the back-up database form I have a prompting label, a textbox(txtLocaction), a browse button(which should call some sort of dialog allowing me to select the location and be able to return it to the txtLocation...


View more questions Search