Check out some similar questions!

Curlyben · Feb 18, 2014, 02:01 AM

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 · 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 · 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 · 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 · 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 · 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 · 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 · 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 · Mar 31, 2014, 06:35 AM

Changes made.
Now getting weird error now...

JBeaucaire · 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 · 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 · 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 · 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