![]() |
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 |
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 |
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 |
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 |
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 |
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