Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 342
  • Last Modified:

Help with Code to convert excel files to PDF then email (code included). How can I run without active sheet open?

Trying to convert and email PDF's, I want to loop and convert more than one file at a time in a folder:

HELP please :)

Sub PDFEmail()

    'Declare variables
    Dim MyFilePath As String
    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.XXXX@XXXXXXX.com"
    EmailSubject = "Please see attached email"
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = ThisWorkbook.Path & "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    MyFileName = ActiveSheet.Name

    'Save Transaction Form as PDF file in same directory as this
    'Excel workbook
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                MyFilePath & MyFileName, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                False
       

    'Create Outlook object
    Set OutlookApp = New Outlook.Application

    'Send out the email
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddress
        .Subject = EmailSubject
        .Body = Msg
        .Attachments.Add MyFilePath & MyFileName & ".PDF"
        .Send
    End With

    'House cleaning
    Set OutlookApp = Nothing

    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."

    Application.ScreenUpdating = True
End Sub

Open in new window

0
gracie1972
Asked:
gracie1972
  • 17
  • 14
1 Solution
 
aikimarkCommented:
Firstly, I think lines 21-24 might be better as:
    Msg = Range("A2").Value

    'Build parts of name of PDF file
    MyFilePath = C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"

Open in new window

Once you know your path, you will add a loop to process all the workbook files in the path
Dim wkb as Workbook
Dim strFile as String
Dim wks as Worksheet

strFile = Dir(MyFilePath & "\*.xl*")
Do Until Len(strFile) = 0
    Set wkb = Application.Openworkbook(MyFilePath & strFile)
    Set wks = wkb.Worksheets("????")    'or wkb.Sheets(##)
    'process the data in the workbook here
    wks.ExportAsFixedFormat   'for example
'...

    wkb.Close
    strFile = Dir()   'get next file name
Loop

Open in new window

Note: that you will need to assign the wks variable to the particular worksheet that has the data.
0
 
gracie1972Author Commented:
@aikimark,
Would the Loop go before the Outlook portion of the code?
0
 
gracie1972Author Commented:
Modified but I am getting an error on the MyFilePath:


Sub PDFEmail()
    'Declare variables
    Dim MyFilePath As String
    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.xxxxx@xxxxxx.com"
    EmailSubject = "Please see attached email"
   
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing\"
    MyFileName = ActiveSheet.Name
   
    Dim wkb As Workbook
    Dim strFile As String
    Dim wks As Worksheet
   
    strFile = Dir(MyFilePath & "\*.xl*")
    Do Until Len(strFile) = 0
    Set wkb = Application.Openworkbook(MyFilePath & strFile)
    Set wks = wkb.Sheets()    'or wkb.Sheets(##)
       
    'process the data in the workbook here
    'Save Transaction Form as PDF file in same directory as this
    'Excel workbook
   
    wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    MyFilePath & MyFileName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False
       
    wkb.Close
    strFile = Dir()   'get next file name
    Loop
   
  'Create Outlook object
    Set OutlookApp = New Outlook.Application

    'Send out the email
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddress
        .Subject = EmailSubject
        .Body = Msg
        .Attachments.Add MyFilePath & MyFileName & ".PDF"
        .Send
    End With

    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
   

End Sub
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
aikimarkCommented:
It goes around the code to save as PDF and to do the email.
0
 
gracie1972Author Commented:
Okay I am not getting this to work, it errors out around :
     
 .Attachments.Add MyFilePath & MyFileName & ".PDF"
0
 
aikimarkCommented:
please post your code in a snippet
0
 
gracie1972Author Commented:
Modified but I am getting an error on the MyFilePath:


Sub PDFEmail()
    'Declare variables
    Dim MyFilePath As String
    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.xxxxx@xxxxxx.com"
    EmailSubject = "Please see attached email"
    
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    MyFileName = strFile
    
    Dim wkb As Workbook
    Dim strFile As String
    Dim wks As Worksheet
    
    strFile = Dir(MyFilePath & "\*.xls*")
    Do Until Len(strFile) = 0
    Set wkb = Application.Openworkbook(MyFilePath & strFile)
    Set wks = wkb.Sheets()    'or wkb.Sheets(##)
        
    'process the data in the workbook here
    'Save Transaction Form as PDF file in same directory as this
    'Excel workbook
    
    wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    MyFilePath & MyFileName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False
       
    wkb.Close
    strFile = Dir()   'get next file name
    Loop
    
  'Create Outlook object
    Set OutlookApp = New Outlook.Application

    'Send out the email
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddress
        .Subject = EmailSubject
        .Body = Msg
        .Attachments.Add MyFilePath & strFile & ".PDF"
        .Send
    End With

    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
    

End Sub

Open in new window

0
 
gracie1972Author Commented:
Actually it is on line 36:  Set wkb = Application.Openworkbook(MyFilePath & strFile)  Now.  Giving me Object does not support property or method.
0
 
aikimarkCommented:
Should be:
Set wkb = Application.Openworkbook(MyFilePath & "\" & strFile)

Open in new window

0
 
gracie1972Author Commented:
Same error?
0
 
aikimarkCommented:
I've corrected all the paths in the code you posted.
Sub PDFEmail()
    'Declare variables
    Dim MyFilePath As String
    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.xxxxx@xxxxxx.com"
    EmailSubject = "Please see attached email"
    
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    MyFileName = strFile
    
    Dim wkb As Workbook
    Dim strFile As String
    Dim wks As Worksheet
    
    strFile = Dir(MyFilePath & "\*.xls*")
    Do Until Len(strFile) = 0
        Set wkb = Application.Openworkbook(MyFilePath & "\" & strFile)
        Set wks = wkb.Sheets()    'or wkb.Sheets(##)
            
        'process the data in the workbook here
        'Save Transaction Form as PDF file in same directory as this
        'Excel workbook
        
        wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyFilePath & "\" & MyFileName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
           
        wkb.Close
        strFile = Dir()   'get next file name
    Loop
    
  'Create Outlook object
    Set OutlookApp = New Outlook.Application

    'Send out the email
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddress
        .Subject = EmailSubject
        .Body = Msg
        .Attachments.Add MyFilePath & "\" & strFile & ".PDF"
        .Send
    End With

    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
End Sub

Open in new window

0
 
gracie1972Author Commented:
Same error, would it happen to be something in my object library I am missing?  That happened when my outlook was not working....

I attached a screen shot.
Capture.PNG
0
 
aikimarkCommented:
What statement is causing the error?
What is the error (number & description)?
0
 
gracie1972Author Commented:
Same place, line 33 on most recent code:

Set wkb = Application.Openworkbook(MyFilePath & "\" & MyFileName)

Runtime error '438", object doesn't support this property or method.
0
 
aikimarkCommented:
Set wkb = Application.workbooks.Open(MyFilePath & "\" & MyFileName)

Open in new window

0
 
gracie1972Author Commented:
That worked, my loop is not working.  Do I have it in the wrong spot?  It stops at the first file in the directory.

Sub SavePDF()
    'Declare variables
    Dim MyFilePath As String
    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.XXXX@XXX.com"
    EmailSubject = "Please see attached email"
    
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    strFile = Dir(MyFilePath & "\*.xls*")
    MyFileName = strFile
    
    Dim wkb As Workbook
    'Dim wks As Worksheet
    
    
    Do Until Len(strFile) = 0
        Set wkb = Application.Workbooks.Open(MyFilePath & "\" & MyFileName)
        'Set wks = wkb.Sheets()    'or wkb.Sheets(##)
            
        'process the data in the workbook here
        'Save Transaction Form as PDF file in same directory as this
        'Excel workbook
        
        wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyFilePath & "\" & MyFileName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
           
        wkb.Close
        strFile = Dir()   'get next file name
    Loop
    
  'Create Outlook object
    Set OutlookApp = New Outlook.Application

    'Send out the email
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddress
        .Subject = EmailSubject
        .Body = Msg
        .Attachments.Add MyFilePath & "\" & MyFileName & ".PDF"
        .Send
    End With

    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
    
End Sub

Open in new window

0
 
aikimarkCommented:
The loop should encompass both the creation of the PDF and the emailing.
0
 
gracie1972Author Commented:
Not sure what you mean, when I try to run it as is, it does not loop to the next file, just the same file over and over.  I have not used Loop before this way.....
0
 
aikimarkCommented:
Like this.  Please note that all the emails will be going to the same person.
Sub SavePDF()
    'Declare variables
    Dim MyFilePath As String
    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.XXXX@XXX.com"
    EmailSubject = "Please see attached email"
    
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    strFile = Dir(MyFilePath & "\*.xls*")
    MyFileName = strFile
    
    Dim wkb As Workbook
    'Dim wks As Worksheet

    'Create Outlook object
    Set OutlookApp = New Outlook.Application

    Do Until Len(strFile) = 0
        Set wkb = Application.Workbooks.Open(MyFilePath & "\" & MyFileName)
        'Set wks = wkb.Sheets()    'or wkb.Sheets(##)
            
        'process the data in the workbook here
        'Save Transaction Form as PDF file in same directory as this
        'Excel workbook
        
        wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyFilePath & "\" & MyFileName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
           
        wkb.Close
    
        'Send out the email
        Set MItem = OutlookApp.CreateItem(olMailItem)
        With MItem
            .To = EmailAddress
            .Subject = EmailSubject
            .Body = Msg
            .Attachments.Add MyFilePath & "\" & MyFileName & ".PDF"
            .Send
        End With
        strFile = Dir()   'get next file name
    Loop

    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
    
End Sub

Open in new window

0
 
gracie1972Author Commented:
The code does not go to the next excel file.  It thinks it is, because I am testing with 4 different files.  4 emails get sent, but all are the same file.

For example there may be 5 or 50 files in this directory.

Thanks for the note about the email, we are testing one email but this will actually be a distribution email we already have set up.
0
 
aikimarkCommented:
This should do it.
Sub SavePDF()
    'Declare variables
    Dim MyFilePath As String
'    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.XXXX@XXX.com"
    EmailSubject = "Please see attached email"
    
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    strFile = Dir(MyFilePath & "\*.xls*")
'    MyFileName = strFile
    
    Dim wkb As Workbook
    'Dim wks As Worksheet

    'Create Outlook object
    Set OutlookApp = New Outlook.Application

    Do Until Len(strFile) = 0
        Set wkb = Application.Workbooks.Open(MyFilePath & "\" & MyFileName)
        'Set wks = wkb.Sheets()    'or wkb.Sheets(##)
            
        'process the data in the workbook here
        'Save Transaction Form as PDF file in same directory as this
        'Excel workbook
        
        wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyFilePath & "\" & strFile, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
           
        wkb.Close
    
        'Send out the email
        Set MItem = OutlookApp.CreateItem(olMailItem)
        With MItem
            .To = EmailAddress
            .Subject = EmailSubject
            .Body = Msg
            .Attachments.Add MyFilePath & "\" & strFile & ".PDF"
            .Send
        End With
        strFile = Dir()   'get next file name
    Loop

    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
    
End Sub

Open in new window

0
 
gracie1972Author Commented:
Strange thing is now this seems to work okay, XLSX are converted to PDF and sent in separate emails.
Only the MSG from the first workbook attaches to all emails even though the attachments are all different.  Is my loop in the wrong spot?
0
 
gracie1972Author Commented:
Where msg = Range(A2)  (this will not change in all documents, but the msg is different)

Sub SavePDF()
    'Declare variables
    Dim MyFilePath As String
'    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.XXXXXXXX@XXXXXXX.com"
    EmailSubject = "Please see attached email"
    Msg = Range("A2")

    'Build parts of name of PDF file
    MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    strFile = Dir(MyFilePath & "\*.xlsx")
    MyFileName = strFile
    
    Dim wkb As Workbook

    'Create Outlook object
    Set OutlookApp = New Outlook.Application

    Do Until Len(strFile) = 0
        Set wkb = Application.Workbooks.Open(MyFilePath & "\" & MyFileName)
        'Set wks = wkb.Sheets()    'or wkb.Sheets(##)
            
        'process the data in the workbook here
        'Save Transaction Form as PDF file in same directory as this
        'Excel workbook
        
        wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyFilePath & "\" & strFile, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
   
        'Send out the email
        Set MItem = OutlookApp.CreateItem(olMailItem)
        With MItem
            .To = EmailAddress
            .Subject = EmailSubject
            .Body = Msg
            .Attachments.Add MyFilePath & "\" & strFile & ".PDF"
            .Send
        End With
        
    strFile = Dir()   'get next file name
    Loop

    
    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
    
    
End Sub

                                          

Open in new window

0
 
aikimarkCommented:
this will not change in all documents, but the msg is different
Not sure what you are saying/describing.

Is msg supposed to change for every opened/saved workbook?
0
 
gracie1972Author Commented:
Where msg = Range(A2)  (this will not change in all documents, but the msg is different)>>>

Depending on the excel spreadsheet, whatever is in cell A2 needs to populate in the body of the email.  In this case the loop by passes this and only pulls in what is cell A2 in the first excel sheet.  The other workbooks attach to the email as a PDF perfectly, however, the message pulled in is from the first workbook.
0
 
aikimarkCommented:
So that needs to happen INSIDE THE LOOP.  Get the pattern?
Sub SavePDF()
    'Declare variables
    Dim MyFilePath As String
'    Dim MyFileName As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim Msg As String


    Application.ScreenUpdating = False

    'Activate the Transaction Form worksheet
    'Worksheets("Transaction Form").Activate

    'Specify email address, email subject, and a brief message
    EmailAddress = "Angela.XXXXXXXX@XXXXXXX.com"
    EmailSubject = "Please see attached email"

    'Build parts of name of PDF file
    MyFilePath = "C:\Users\matthane\Documents\OLD_ECOM_DATA\Missing"
    strFile = Dir(MyFilePath & "\*.xlsx")
    MyFileName = strFile
    
    Dim wkb As Workbook

    'Create Outlook object
    Set OutlookApp = New Outlook.Application

    Do Until Len(strFile) = 0
        Set wkb = Application.Workbooks.Open(MyFilePath & "\" & MyFileName)
        'Set wks = wkb.Sheets()    'or wkb.Sheets(##)
            
        'process the data in the workbook here
        'Save Transaction Form as PDF file in same directory as this
        'Excel workbook

        Msg = Range("A2")
        
        wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            MyFilePath & "\" & strFile, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
   
        'Send out the email
        Set MItem = OutlookApp.CreateItem(olMailItem)
        With MItem
            .To = EmailAddress
            .Subject = EmailSubject
            .Body = Msg
            .Attachments.Add MyFilePath & "\" & strFile & ".PDF"
            .Send
        End With
        
        strFile = Dir()   'get next file name
    Loop

    
    'House cleaning
    Set OutlookApp = Nothing
    MsgBox "Email has been sent.  BTW Your coffee and danish are waiting downstairs."
    Application.ScreenUpdating = True
    
    
End Sub

Open in new window

0
 
gracie1972Author Commented:
For some reason, it still only pulls from the first worksheet.  I tried moving inside the loop as well as adding wkb.close before sending out the email.

Any thoughts?
0
 
gracie1972Author Commented:
Hard work, thank you so much!
0
 
aikimarkCommented:
it still only pulls from the first worksheet
Pulls what?
0
 
gracie1972Author Commented:
Is it possible to schedule this code as a job in scheduler?  What is the best way to automate this in your experience?  Also that last code did work :)
0
 
aikimarkCommented:
You should be able to.  You can launch Access and specify the automatic execution of code (macro) as a command line parameter.  I think it is the /x command line parameter.

You would create a scheduled task with this string, once you've tested it.  Be aware that you might need to use quote characters if your either of your paths contain space (or special) characters.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 17
  • 14
Tackle projects and never again get stuck behind a technical roadblock.
Join Now