Link to home
Start Free TrialLog in
Avatar of katarina11
katarina11

asked on

Visual Basic - code question

Hi there,
I have created a macro in Excel 2007 using Visual Basic..
When I run it, it will take an excel sheet, turn it into a .pdf, ask you where you want to save it and then save it there as a pdf with the sheet name, and then it will open up an email (Outlook) automatically with the .pdf attached.
My question is, I want to automatically save the .pdf to c:/temp without being prompted where to save it....so all that I will see is the email with the attached .pdf pop-up and not a prompt of where to save the file.
I have tried changing the code, but I cannot for the life of me seem to get this to work...any VBE experts out there that might be able to give me a hand? This is my code:

Option Explicit
 Sub create_and_email_pdf()
 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
 CurrentMonth = ""
 ' *****************************************************
 ' ***** You Can Change These Variables *********
 EmailSubject = "Please see attached pdf " 'Change this to change the subject of the email. The current month is added to end of subj line
 OpenPDFAfterCreating = True 'Change this if you want to open the PDF after creating it : TRUE or FALSE
 AlwaysOverwritePDF = False 'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
 DisplayEmail = True 'Change this if you don't want to display the email before sending. Note, you must have a TO email address specified for this to work
 Email_To = "" 'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
 Email_CC = ""
 Email_BCC = ""
 ' ******************************************************
 '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 = Mid(ActiveSheet.Range("H6").Value, InStr(1, ActiveSheet.Range("H6").Value, " ") + 1)
 'Create new PDF file name including path and file extension
 PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
 & "_" & CurrentMonth & ".pdf"
 'If the PDF already exists
 If Len(Dir(PDFFile)) > 0 Then
 If AlwaysOverwritePDF = False Then
 OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
 On Error Resume Next
 'If you want to overwrite the file then delete the current one
 If OverwritePDF = vbYes Then
 Kill PDFFile
 Else
 MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
 & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
 Exit Sub
 End If
 Else
 On Error Resume Next
 Kill PDFFile
 End If
 If Err.Number <> 0 Then
 MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
 & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
 Exit Sub
 End If
 End If
 '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 = EmailSubject & CurrentMonth
 .Attachments.Add PDFFile
 If DisplayEmail = False Then
 .Send
 End If
 End With
 End Sub
 
Thanks in Advance:)
ASKER CERTIFIED SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of katarina11
katarina11

ASKER

Thanks for replying!  I tried changing that, but it still keeps defaulting to opening my Documents to choose a folder to save the .pdf in....it does not automatically save it to c:\temp...
It works now...THANK YOU:)
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014