My VBA code downloads attachments from emails to my local drive. I would like to rename the attachments to include the date. The date should be the day before the email was received.
Public Sub SaveAutoAttach(item As Outlook.MailItem)
Dim object_attachment As Outlook.Attachment
Dim saveFolder As String
' Folder location when I want to save my file
saveFolder = "\\gbhxxxx\Groups\Shared\EBS\Post Go-Live\Auto MT940 download Test"
For Each object_attachment In item.Attachments
' Criteria to save .940 files only
If InStr(object_attachment.DisplayName, "UKAutoMT940") Then
object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName
End If
Next
End Sub
Updated your code below to append the date BEFORE the display file name. We do this by using DATEADD and adding -1 days to the recieved date and FORMATting the datetime value into a date value with "-"s instead of "/"s.
If you're looking to add it AFTER the filename but before the extension, we'll need to parse to filename.
Public Sub SaveAutoAttach(item As Outlook.MailItem)
Dim object_attachment As Outlook.Attachment
Dim saveFolder As String
' Folder location when I want to save my file
saveFolder = "\\gbhxxxx\Groups\Shared\EBS\Post Go-Live\Auto MT940 download Test"
For Each object_attachment In item.Attachments
' Criteria to save .940 files only
If InStr(object_attachment.DisplayName, "UKAutoMT940") Then
object_attachment.SaveAsFile saveFolder & "\" & Format(DateAdd("d", -1, item.ReceivedTime), "dd-mm-yyyy") & "_" & object_attachment.DisplayName
End If
Next
End Sub
Related
I need VBA code to use in Outlook to extract the PDF attachments from emails and save into a designated folder. The user will choose the emails.
I have the below code but need it amended.
Public Sub SaveAutoAttach(item As Outlook.MailItem)
Dim object_attachment As Outlook.Attachment
Dim saveFolder As String
' Folder location when I want to save my file
saveFolder = "D:\Data\Archive"
For Each object_attachment In item.Attachments
' Criteria to save .doc files only
If InStr(object_attachment.DisplayName, ".doc") Then
object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName
End If
Next
End Sub
As per your request, the following macro will save any PDF attachments from one or more user selected items.
Option Explicit
Sub SaveAttachmentsFromSelectedItemsPDF()
Dim currentItem As Object
Dim currentAttachment As Attachment
Dim saveToFolder As String
Dim savedFileCountPDF As Long
saveToFolder = "c:\users\domenic\desktop" 'change the path accordingly
savedFileCountPDF = 0
For Each currentItem In Application.ActiveExplorer.Selection
For Each currentAttachment In currentItem.Attachments
If UCase(Right(currentAttachment.DisplayName, 4)) = ".PDF" Then
currentAttachment.SaveAsFile saveToFolder & "\" & _
Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 4) & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".pdf"
savedFileCountPDF = savedFileCountPDF + 1
End If
Next currentAttachment
Next currentItem
MsgBox "Number of PDF files saved: " & savedFileCountPDF, vbInformation
End Sub
I'm trying to put together some VBA that will save an attachment that I get sent daily to a folder on my network, I've got as far as the attachment being saved to the correct location, however, I want to prefix the document with the date in which it was saved.
The attachment is summary.rtf and I'd like it to be 20160805_summary.rtf etc.
My VBA are essentially NOTHING (I'm a SQL girl), so any simple advice would be so greatly appreciated, I've been revisiting this for days and can't find any help anywhere!
My current code looks like this:
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "X:\Tessitura\Shared Full Access\Secure_CXL_Reports"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
I would be so grateful for any extra help!
You need to add the below section into the line, format will change the form of your date to the one required and date will return the current date, change the y/d/m for the format as required.
format(date, "yyyymmdd")
This is the line inserted into your code.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "X:\Tessitura\Shared Full Access\Secure_CXL_Reports"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & format(date, "yyyymmdd") & "_" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
I have a fairly straight forward scenario where I get an email every day with a zip file attached and I would like to be able to more easily parse this information. In order to do so I just need to be able to download the attachment to a folder and then extract it.
To download the attachment I did the following
Public Sub SaveZip(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
This works as expected, the .zip file gets dumped into the temp directory. I found the following code which on all accounts seems to be what I need to implement in order to extract the .zip
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(saveFolder).CopyHere oApp.NameSpace.Items
I have not been able to implement this into my existing code without generating a host of errors (due to my own lack of understanding I am sure)
Any input on this would be greatly appreciated
Final Edit
Got it, thanks to Tim for all the help. The following will download attachments (always named the same thing) from an incoming email into c:\temp, extract them to c:\temp\unzipped, rename the file, and finally delete the .zip in c:\temp.
Public Sub SaveZip(itm As Outlook.MailItem)
Const saveFolder = "C:\Temp\"
Const fileFolder = "C:\CBH\"
Dim objAtt As Outlook.Attachment
Dim oApp As Object
Dim dName As Variant
For Each objAtt In itm.Attachments
dName = objAtt.DisplayName
objAtt.SaveAsFile saveFolder & dName
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace("C:\CBH").CopyHere _
oApp.NameSpace(saveFolder & dName).Items
Name fileFolder & "CallsByHour.xls" As fileFolder & "CBH-" & Format(Date, "yyyymmdd") & ".xls"
Kill saveFolder & dName
Next
End Sub
Assuming you're coding in Outlook, this will process the item selected in Outlook, saving the attachment to C:\Temp and extracting the zip contents to C:\Temp\unzipped
EDIT (untested) - added date-time based subfolder
Sub Tester()
SaveZip Application.ActiveExplorer.Selection.Item(1)
End Sub
Public Sub SaveZip(itm As Outlook.MailItem)
Const saveFolder = "C:\Temp\"
Dim objAtt As Outlook.Attachment
Dim oApp As Object
Dim dName As Variant, unZipFolder
If itm.Attachments.Count > 0 Then
unZipFolder = saveFolder & "unzipped\" & " _
Format(Now,"yyyymmdd_hhmss")
MkDir unZipFolder
For Each objAtt In itm.Attachments
dName = objAtt.DisplayName
objAtt.SaveAsFile saveFolder & dName
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(unZipFolder).CopyHere _
oApp.NameSpace(saveFolder & dName).Items
Next
End If 'any attachments
End Sub
I am currently receiving weekly reports on outlook which I need to open and save in a specific folder. I have succeeded in renaming the file and transferring it to the desired file.
HOWEVER, the file format isn't the same as the file which is attached to the email, it is either registered as type "file" when I do not put a date format at the end or a type ".2016" file when I put one. When opened in Notepad the information is unreadable
Here is the code I currently use:
Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormatdateFormat = Format(Now, "dd.mm.yyyy")
saveFolder = "C:\Users\mypathtotheattachment"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & "thenewnameofmyattachment" & ".csv"
Next
End Sub
Any help is welcome, I scanned all over the place for any information but I'm stuck...
Thanks!
Is this what your trying to do?
Option Explicit
Public Sub SaveAtmtToDisk(Item As Outlook.MailItem)
Dim Atmt As Outlook.Attachment
Dim SavePath As String
Dim FileName As String
' // Saved Location
SavePath = "C:\temp\"
' // 05 24 2016 Antoine.csv
FileName = Format(Now, "DD MM YYYY") & " Antoine.csv"
For Each Atmt In Item.Attachments
Atmt.SaveAsFile SavePath & "\" & FileName
Next
Set Atmt = Nothing
End Sub
Tested on Outlook 2010
Basically the script below works along with a rule in OUTLOOK. When I receive the email it saves the PDF attachment. The problem I am having is I want to change the file name (objAtt.SaveAsFile). The file name that it comes in as is something like “userid.jobname.JOB22979……..”. I would like to save the file using the second node (jobname in this case), followed by the date and time. I believe I can get the file name from object objAtt.DisplayName, but I don’t know how to pick up just the second node in the file name.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm-ss")
saveFolder = "c:\users\xxxxxx\USER\documents\email\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & dateFormat & "print.pdf"
Set objAtt = Nothing
Next
End Sub
Split to pull out the 2nd token;
DisplayName = "userid.jobname.JOB22979.blah"
job = Split(DisplayName & ".", ".")(1)
If Len(job) > 0 Then
job = job & "_" & Format$(Now, "yyyy-mm-dd H-mm-ss") & "_print.pdf"
Else
'// no match, use original
job = DisplayName
End If
objAtt.SaveAsFile saveFolder & job