Loop Macro to save each tab as an individual PDF and automatically email out

erenkey

Board Regular
Joined
Dec 9, 2005
Messages
161
I have a workbook in Excel that has multiple tabs. I have a macro that will save the active tab as a PDF and then email the PDF to the email address that is in cell AB1. The code works great if I run it for each tab individually. I would like to loop the macro to run for each tab in the workbook. Can anyone help me add the necessary code for the loop?

Here is the code that I am using.

Sub Individual_Scores()
ChDir "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf", OpenAfterPublish:=True

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments

With OutLookMailItem
.to = Range("AB1").Value
.Subject = ActiveSheet.Name & " Zubie Scores"
.Body = "Testing Save to PDF and Email."
myAttachments.Add "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf"
.Send
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing


End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

xlyfe

Board Regular
Joined
Aug 28, 2020
Messages
53
Office Version
  1. 365
Platform
  1. Windows
Does this work?
VBA Code:
      Sub Individual_Scores()

         Dim wsCnt As Integer
         Dim i As Integer

         wsCnt = ActiveWorkbook.Worksheets.Count

         For i = 1 To wsCnt

            ChDir "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf", OpenAfterPublish:=True
            
            Dim OutLookApp As Object
            Dim OutLookMailItem As Object
            Dim myAttachments As Object
            
            Set OutLookApp = CreateObject("OutLook.Application")
            Set OutLookMailItem = OutLookApp.CreateItem(0)
            Set myAttachments = OutLookMailItem.Attachments
            
            With OutLookMailItem
            .To = Range("AB1").Value
            .Subject = ActiveSheet.Name & " Zubie Scores"
            .Body = "Testing Save to PDF and Email."
            myAttachments.Add "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf"
            .Send
            End With
            
            Set OutLookMailItem = Nothing
            Set OutLookApp = Nothing

         Next i

      End Sub
 

erenkey

Board Regular
Joined
Dec 9, 2005
Messages
161
Sub Individual_Scores() Dim wsCnt As Integer Dim i As Integer wsCnt = ActiveWorkbook.Worksheets.Count For i = 1 To wsCnt ChDir "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf", OpenAfterPublish:=True Dim OutLookApp As Object Dim OutLookMailItem As Object Dim myAttachments As Object Set OutLookApp = CreateObject("OutLook.Application") Set OutLookMailItem = OutLookApp.CreateItem(0) Set myAttachments = OutLookMailItem.Attachments With OutLookMailItem .To = Range("AB1").Value .Subject = ActiveSheet.Name & " Zubie Scores" .Body = "Testing Save to PDF and Email." myAttachments.Add "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf" .Send End With Set OutLookMailItem = Nothing Set OutLookApp = Nothing Next i End Sub
Thanks for the reply but the loop is not working. When I run the code it only runs for the first tab but not any of the others.
 

erenkey

Board Regular
Joined
Dec 9, 2005
Messages
161
Does anyone have any suggestions? I believe that I need to change the "ActiveSheet" line in the code because what I am wanting it to do utilizes all of the sheets in the workbook instead of only the active one.

or

Is there a way to assign this macro to a specific worksheet by naming it in the code somewhere? I can then recreate the same code for each defines worksheet and then create a call macro that will call all of my individual macros in order. I know this is not the most efficient way to do it but it should work.

Thank you for any help.
 

Watch MrExcel Video

Forum statistics

Threads
1,132,785
Messages
5,655,293
Members
418,187
Latest member
polks111

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top