Modify File before saving it.

[josros60]

Hi,

found very helpful code to print multiples attachments in outlook, just wonder if can prompt to when open file to fix like columns showing ##### because is narrow after modifying saving it.

here is the code ( and after will put a sample that you can see that date cannot see it because columns no wide enough is excel file converted to pdf)

Sub BatchPrintAllAttachmentsinMultipleEmails()
    Dim objFileSystem As Object
    Dim strTempFolder As String
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Dim objShell As Object
    Dim objTempFolder As Object
    Dim objTempFolderItem As Object
    Dim strFilePath As String
 
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Attachments " & Format(Now, "YYYY-MM-DD_hh-mm-ss")
    'Create a new temp folder
    MkDir (strTempFolder)
 
    Set objSelection = Outlook.Application.ActiveExplorer.Selection
 
    For Each objItem In objSelection
        If TypeOf objItem Is MailItem Then
           Set objMail = objItem
           Set objAttachments = objMail.Attachments
 
           'Save all the attachments in the temp folder
           For Each objAttachment In objAttachments
               strFilePath = strTempFolder & "\" & objAttachment.FileName
               objAttachment.SaveAsFile (strFilePath)
 
               'Print all the files in the temp folder
               Set objShell = CreateObject("Shell.Application")
               Set objTempFolder = objShell.NameSpace(0)
               Set objTempFolderItem = objTempFolder.ParseName(strFilePath)
               objTempFolderItem.InvokeVerbEx ("print")
           Next objAttachment
        End If
    Next
End Sub

Sample:

 

[josros60]

Tried.

thould it would pause for 10 seconds keep csv file open modify it and after saving it, but no.


thank you,

 

[Domenic]

Don't know why you're unable to open the PDF file with your Chrome browser. As I mentioned, when I tested your code, it created a PDF file, and I was able to open it with my Chrome browser without a problem.

If you want, we could try a different method of creating a PDF file. After the workbook is opened and the column width is adjusted, we can use the ExportAsFixedFormat method of the Worksheet object to export the worksheet to a PDF file. Then, once the PDF is created, the workbook is closed, and on to the next one.

Do you want to try it?

 

[josros60]

If you don't mind.

Thank you

 

[Domenic]

Okay, I have modified your code so that it uses the ExportAsFixedFormat method of the Worksheet object to export to PDF. You'll need to change the path to the destination folder for the PDF's where indicated in the code. Also, note that the sheet name, along with the date and time, are used to name each PDF file. You can change the naming convention as desired.

Sub BatchPrintAllAttachmentsinMultipleEmails()
    Dim objFileSystem As Object
    Dim strTempFolder As String
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Dim objShell As Object
    Dim objTempFolder As Object
    Dim objTempFolderItem As Object
    Dim strFilePath As String
    Dim destFolder As String
    Dim wb As Workbook
 
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Attachments " & Format(Now, "YYYY-MM-DD_hh-mm-ss")
    'Create a new temp folder
    MkDir (strTempFolder)
    
    destFolder = "C:\Users\Domenic\Desktop\" 'change the destination folder for the PDF's as desired
    If Right(destFolder, 1) <> "\" Then
        destFolder = destFolder & "\"
    End If
 
    Set objSelection = Outlook.Application.ActiveExplorer.Selection
 
    For Each objItem In objSelection
        If TypeOf objItem Is MailItem Then
           Set objMail = objItem
           Set objAttachments = objMail.Attachments
 
           'Save all the attachments in the temp folder
           For Each objAttachment In objAttachments
               strFilePath = strTempFolder & "\" & objAttachment.Filename
               objAttachment.SaveAsFile strFilePath
               Set wb = Workbooks.Open(strFilePath)
               wb.Worksheets(1).Columns("A:B").AutoFit
               wb.ExportAsFixedFormat xlTypePDF, destFolder & wb.Worksheets(1).Name & " " & Format(Now, "YYYY-MM-DD_hh-mm-ss") & ".pdf"
               wb.Close SaveChanges:=False
           Next objAttachment
        End If
    Next
End Sub

Does this help?

 

[josros60]

Thank you, So much worked good.

one more question if you don't mind instead printing all backup how can just print the file selected?


thanks again.

 

[Domenic]

Thank you, So much worked good.

That's great, glad to hear it.

one more question if you don't mind instead printing all backup how can just print the file selected?

Sorry, but I don't quite understand. Can you please elaborate?

 

[josros60]

Ok,

For example receive an pdf invoice and backup either xslx or CSV format the same invoice in Outlook right click and save as to give a name the just select backup and print it.

Thanks again

 

[Domenic]

Still somewhat unclear. It looks like you receive an email with one or more attachments, and that the attachments include either an xlsx or csv file, and that you simply want to print to PDF the xlsx or csv file, which ever one is included. If this is correct, as you loop through each attachment, simply check the file extension for .xlsx or .csv, then print to PDF, and then exit the For loop. For example, you can do something like this . . .

           For Each objAttachment In objAttachments
              If LCase(Right(objAttachment.Filename, 4)) = ".csv" Or LCase(Right(objAttachment.Filename, 5)) = ".xlsx" Then
                strFilePath = strTempFolder & "\" & objAttachment.Filename
                objAttachment.SaveAsFile (strFilePath)
                Set wb = Workbooks.Open(strFilePath)
                wb.Worksheets(1).Columns("A:B").AutoFit
                wb.ExportAsFixedFormat xlTypePDF, destFolder & wb.Worksheets(1).Name & " " & Format(Now, "YYYY-MM-DD_hh-mm-ss") & ".pdf"
                wb.Close SaveChanges:=False
                Exit For
              End If
           Next objAttachment

Also, if you would like to be prompted for a save-as filename, you can use the GetSaveAsFilename method of the Application object, and then use the save-as filename for the Filename argument in ExportAsFixedFormat.

 

[josros60]

Thank you.

That's exactly what I would like, how can I insert your suggestions into the one you provided me previously modification and add these new suggestions.


Thanks again.

 

[Domenic]

Try the following macro . . .

Sub BatchPrintAllAttachmentsinMultipleEmails()
    Dim objFileSystem As Object
    Dim strTempFolder As String
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Dim objShell As Object
    'Dim objTempFolder As Object
    'Dim objTempFolderItem As Object
    Dim strFilePath As String
    Dim saveAsPdfFilename As Variant
    Dim wb As Workbook
  
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Attachments " & Format(Now, "YYYY-MM-DD_hh-mm-ss")
    'Create a new temp folder
    MkDir (strTempFolder)
 
    Set objSelection = Outlook.Application.ActiveExplorer.Selection
 
    For Each objItem In objSelection
        If TypeOf objItem Is MailItem Then
           Set objMail = objItem
           Set objAttachments = objMail.Attachments
           For Each objAttachment In objAttachments
              If LCase(Right(objAttachment.Filename, 4)) = ".csv" Or LCase(Right(objAttachment.Filename, 5)) = ".xlsx" Then
                    saveAsPdfFilename = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path, FileFilter:="PDF File (*.pdf), *.pdf", Title:="Save As")
                    If saveAsPdfFilename = False Then Exit Sub
                    strFilePath = strTempFolder & "\" & objAttachment.Filename
                    objAttachment.SaveAsFile strFilePath
                    Set wb = Workbooks.Open(strFilePath)
                    wb.Worksheets(1).Columns("A:B").AutoFit
                    wb.ExportAsFixedFormat xlTypePDF, saveAsPdfFilename
                    wb.Close SaveChanges:=False
                    Exit For
              End If
           Next objAttachment
        End If
    Next
End Sub

Note, when the user is prompted to name the PDF file, the default folder is the one in which the workbook running the code is located (ie. ThisWorkbook.Path). You can change this as desired. Also note, if the user cancels the SaveAs prompt, it exits the sub.

Hope this helps!