Ask Me Help Desk

Ask Me Help Desk (https://www.askmehelpdesk.com/forum.php)
-   Spreadsheets (https://www.askmehelpdesk.com/forumdisplay.php?f=395)
-   -   Is this possible in ONE button (https://www.askmehelpdesk.com/showthread.php?t=784774)

  • Feb 18, 2014, 02:01 AM
    Curlyben
    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..
  • Feb 20, 2014, 09:35 PM
    JBeaucaire
    SaveAs PDF and Email is a pretty common activity. Here's the best primer on that:

    http://www.rondebruin.nl/pdf.htm
  • Mar 26, 2014, 05:08 AM
    Curlyben
    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
  • Mar 26, 2014, 11:41 PM
    JBeaucaire
    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"
  • Mar 27, 2014, 07:05 AM
    Curlyben
    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
  • Mar 27, 2014, 09:35 PM
    JBeaucaire
    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
  • Mar 28, 2014, 01:44 AM
    Curlyben
    1 Attachment(s)
    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.

    Attachment 45854
    I've attached my sheet.
  • Mar 29, 2014, 02:14 AM
    JBeaucaire
    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.
  • Mar 31, 2014, 06:35 AM
    Curlyben
    1 Attachment(s)
    Changes made.
    Now getting weird error now...
  • Apr 3, 2014, 08:31 PM
    JBeaucaire
    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
  • Apr 8, 2014, 12:52 AM
    Curlyben
    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
  • Apr 9, 2014, 02:10 PM
    Curlyben
    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.
  • Apr 11, 2014, 12:19 AM
    JBeaucaire
    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

    • All times are GMT -7. The time now is 10:01 AM.