VBA excel - Loop and directory|VBA & Macros|Excel Forum|My Online Training Hub

Hi

Thank you for your information.

I tried to paste it after my emailscript but it loops on the same page. How do I ask to move to the next worksheet until all of them are sent?

Also, what is the path format to automatically save in a particular folder?

thanks again

---------------------------------Script-------------------------------

Sub create_and_email_pdf()
' Create a PDF from the current sheet and email it as an attachment through Outlook

Dim EmailSubject As String, EmailSignature As String

Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim ws As Worksheet

CurrentMonth = ""

'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)

If .Show = True Then
DestFolder = .SelectedItems(1)
Else

MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
Exit Sub
End If
End With

'Current month/year stored in H6 (this is a merged cell)
CurrentMonth = ActiveSheet.Range("H1").Value

'Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& "_" & CurrentMonth & ".pdf"

'Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating

'Create an Outlook object and new mail message
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

'Display email and specify To, Subject, etc
With OutlookMail

.Display
.To = Email_To
.CC = Email_CC
.BCC = Email_BCC
.Subject = ActiveSheet.Name & EmailSubject & CurrentMonth
.Attachments.Add PDFFile
.Body = "Dear Customer," & vbNewLine & vbNewLine & "Please find attached your latest statement." & vbNewLine & vbNewLine & "Kindest Regards" & vbNewLine & vbNewLine & "West Pharmaceutical Services, Inc." & vbNewLine & "www.westpharma.com"

If DisplayEmail = False Then
.Send

End If

End With

For Each ws In ThisWorkbook.Worksheets
ws.Activate
EmailScript
Next
End Sub

awesome. thank you so much.

one last question if you don't mind.

How do I code to have the email sent automatically? At the moment it creates the email and I need to press on SEND.

Again thank you so much for your help

thank you. I had to make a change to make it work but thank you so much.