ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Mail Multiple Sheets via PDF Q (https://www.excelbanter.com/excel-programming/443676-mail-multiple-sheets-via-pdf-q.html)

Seanie

Mail Multiple Sheets via PDF Q
 
I'm using Ron De Bruins code to PDF an Excel sheet, it works great
except when I try to PDF more than one sheet it does not extract the
specified sheets at all. I'm getting a little confused, so below is
the code

Sub Mail_PDF()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim sh As Worksheet
Dim cell As Range
Dim strbody As String
Dim FilenameStr As String
Dim TempWb As Workbook

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(olMailItem)


Set Sourcewb = ActiveWorkbook

If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE"
_
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <
"" Then

Sourcewb.Sheets(Array("SheetA", "SheetB")).Copy
Set TempWb = ActiveWorkbook

On Error Resume Next
Sheets("SheetA").Select
ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete
On Error GoTo 0


'Change all cells in the worksheets to values if you want
With TempWb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False

For Each cell In ThisWorkbook.Sheets("SheetA") _
.Columns("BC").Cells.SpecialCells(xlCellTypeConsta nts)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

FilenameStr = Application.DefaultFilePath & "\" & "Part of " &
Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm") & "~.pdf"

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FilenameStr, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

'Close the new workbook you create file without saving
TempWb.Close False


Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)


For Each cell In ThisWorkbook.Sheets("SheetA").Range("BF2:BF35")
strbody = strbody & cell.Value & vbNewLine
Next


On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = strto
.Subject =
ThisWorkbook.Sheets("SheetA").Range("BA1").Value
.Body = strbody
.Attachments.Add Destwb.FullName
.ReadReceiptRequested = True
If Sheets("SheetA").Range("D192").Value 0 Then
.Importance = 2
Else
.Importance = 1
End If
.SendUsingAccount = OutApp.Session.Accounts.Item(3)
.Send
End With
On Error GoTo 0


'Delete the file you send
Kill FilenameStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Else

MsgBox "PDF add-in Not Installed"
End If

End Sub

AB[_2_]

Mail Multiple Sheets via PDF Q
 
Didn't really understand 100% what's happening wrong but having had a
quick look at your code this:

ActiveSheet.ExportAsFixedFormat

would suggest that you're exporting only the activesheet and i didn't
see there any loops going through all of the sheets of the wb.
Not sure if i go that right but something you might wanna look at.


On Sep 30, 1:44*pm, Seanie wrote:
I'm using Ron De Bruins code to PDF an Excel sheet, it works great
except when I try to PDF more than one sheet it does not extract the
specified sheets at all. I'm getting a little confused, so below is
the code

Sub Mail_PDF()
* * Dim FileExtStr As String
* * Dim FileFormatNum As Long
* * Dim Sourcewb As Workbook
* * Dim Destwb As Workbook
* * Dim TempFilePath As String
* * Dim TempFileName As String
* * Dim OutApp As Outlook.Application
* * Dim OutMail As Outlook.MailItem
* * Dim sh As Worksheet
* * Dim cell As Range
* * Dim strbody As String
* * Dim FilenameStr As String
* * Dim TempWb As Workbook

* * Set OutApp = CreateObject("Outlook.Application")
* * OutApp.Session.Logon
* * Set OutMail = OutApp.CreateItem(olMailItem)

* * Set Sourcewb = ActiveWorkbook

* * If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE"
_
* * * * *& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <
"" Then

* * Sourcewb.Sheets(Array("SheetA", "SheetB")).Copy
* * * * Set TempWb = ActiveWorkbook

* * * * On Error Resume Next
* * Sheets("SheetA").Select
* * ActiveSheet.DrawingObjects.Visible = True
* * ActiveSheet.DrawingObjects.Delete
* * On Error GoTo 0

* * * * * 'Change all cells in the worksheets to values if you want
* * With TempWb.Sheets(1).UsedRange
* * .Cells.Copy
* * .Cells.PasteSpecial xlPasteValues
* * .Cells(1).Select
* * End With
* * Application.CutCopyMode = False

* * For Each cell In ThisWorkbook.Sheets("SheetA") _
* * .Columns("BC").Cells.SpecialCells(xlCellTypeConsta nts)
* * * * If cell.Value Like "?*@?*.?*" Then
* * * * * * strto = strto & cell.Value & ";"
* * * * End If
* * Next
* * strto = Left(strto, Len(strto) - 1)

* * * * FilenameStr = Application.DefaultFilePath & "\" & "Part of " &
Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm") & "~.pdf"

* * * * ActiveSheet.ExportAsFixedFormat _
* * * * * * * * Type:=xlTypePDF, _
* * * * * * * * Filename:=FilenameStr, _
* * * * * * * * Quality:=xlQualityStandard, _
* * * * * * * * IncludeDocProperties:=True, _
* * * * * * * * IgnorePrintAreas:=False, _
* * * * * * * * OpenAfterPublish:=False

* * * * 'Close the new workbook you create file without saving
* * * * TempWb.Close False

* * * * Set OutApp = CreateObject("Outlook.Application")
* * * * OutApp.Session.Logon
* * * * Set OutMail = OutApp.CreateItem(0)

* * For Each cell In ThisWorkbook.Sheets("SheetA").Range("BF2:BF35")
* * strbody = strbody & cell.Value & vbNewLine
* * Next

* * * * On Error Resume Next
* * * * With OutMail
* * * * * * .To = ""
* * * * * * .CC = ""
* * * * * * .BCC = strto
* * * * * * .Subject =
ThisWorkbook.Sheets("SheetA").Range("BA1").Value
* * * * * * .Body = strbody
* * * * * * .Attachments.Add Destwb.FullName
* * * * * * .ReadReceiptRequested = True
* * * * * * If Sheets("SheetA").Range("D192").Value 0 Then
* * * * * * .Importance = 2
* * * * * * Else
* * * * * * .Importance = 1
* * * * * * End If
* * * * * * .SendUsingAccount = OutApp.Session.Accounts.Item(3)
* * * * * * .Send
* * * * End With
* * * * On Error GoTo 0

* * 'Delete the file you send
* * Kill FilenameStr

* * Set OutMail = Nothing
* * Set OutApp = Nothing

* * With Application
* * * * .ScreenUpdating = True
* * * * .EnableEvents = True
* * End With
* * Else

* * MsgBox "PDF add-in Not Installed"
* * End If

End Sub



Seanie

Mail Multiple Sheets via PDF Q
 
Thanks, I assumed the code below was all I needed, to then PDF

Sourcewb.Sheets(Array("SheetA", "SheetB")).Copy
Set TempWb = ActiveWorkbook


Not sure how to adjust - ActiveSheet.ExportAsFixedFormat to
incorporate the 2 Sheets i.e. SheetA & SheetB




AB[_2_]

Mail Multiple Sheets via PDF Q
 
What that .copy does is it copies the worksheets of your interest over
to the temp wb.
But this
ActiveSheet.ExportAsFixedFormat
exports only the Active sheet.
So, what you can do is something along the lines

Dim oneSheet as Worksheet
For each oneSheet in TempWb.Worksheets
oneSheet.ExportAsFixedFormat
Next oneSheet

This then will loop through all the sheets in that tempwb and will
export those to pdf.
I don't know how your .pdf driver is set up but the above loop will
export each sheet as a separate .pdf file - perhaps that's what you
need.


On Oct 1, 11:07*am, Seanie wrote:
Thanks, I assumed the code below was all I needed, to then PDF

* * Sourcewb.Sheets(Array("SheetA", "SheetB")).Copy
* * * * Set TempWb = ActiveWorkbook

Not sure how to adjust - *ActiveSheet.ExportAsFixedFormat *to
incorporate the 2 Sheets i.e. SheetA & SheetB



Seanie

Mail Multiple Sheets via PDF Q
 
Thanks for your reply, ideally I would want each sheet to be a new
page on the PDF file




AB[_2_]

Mail Multiple Sheets via PDF Q
 
I'm not that good at automating .pdf from excel and when i had to do
something like that i was saving each .pdf as separate files (what
your current code would do) and then combining them together from
within Excel by automating the .pdf as oppose to writing all the
sheets into a single .pdf to begin with.
You can try googling 'automate pdf excel' or something similar.
Unfortuanatelly i haven't saved that code of mine and currently my pc
doesn't have any .pdf autmation installed and hence i can't even try
replicating it for you...

When you do it manually - i.e., when you manually create a pdf from
within your excel - can you actually get all the sheets into a
single .pdf file? If so, then try recording macro while doing that and
then edit as necessary.


On Oct 1, 12:00*pm, Seanie wrote:
Thanks for your reply, ideally I would want each sheet to be a new
page on the PDF file




All times are GMT +1. The time now is 08:36 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com