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
Related
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 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
I am having an issue getting my code to work. This is my first time running a VBA script. I have a large amount of emails coming in from a fax machine and I want to be able to download the attachments, rename the file to the subject line and then store them on my computer.
My first attempt, I tried to just write a macro so that I could manually do it but after doing some research, I was under the impression that I wanted to make rules work.
This is my first attempt at VBA so I'm not even sure I am running the macro or rule script correctly but I have a feeling I am just missing something in the code. Any thoughts?
Public Sub saveAttachtoDiskRule(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName
Dim file As String
Dim DateFormat As String
Dim newName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
saveFolder = enviro & "\" & "\destinationfolder\"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each objAtt In itm.Attachments
file = saveFolder & objAtt.DisplayName
objAtt.SaveAsFile file
Set oldName = fso.GetFile(file)
newName = itm.Subject
oldName.Name = newName
Set objAtt = Nothing
Next
Set fso = Nothing
End Sub
Here is simple rule script
Public Sub saveAttachtoDisk(olItem As Outlook.MailItem)
Dim olAttachment As Outlook.Attachment
Dim SaveFolder As String
SaveFolder = "c:\temp\"
For Each olAttachment In olItem.Attachments
olAttachment.SaveAsFile SaveFolder & "\" & olAttachment.DisplayName
Set olAttachment = Nothing
Next
End Sub
Environ Function
The Environ function lets you get the Windows environment variables for the computer your code is currently running on, Like user name or the name of the temporary folder
Examples
user's profile folder example is
Environ("USERPROFILE") & "\Documents\Temp\"
result
Windows Vista/7/8: C:\Users\Omar\
Windows XP: C:\Documents and Settings\Omar\
"All Users" or "Common" profile folder
Environ("ALLUSERSPROFILE")
Temporary folder example is
Environ("TEMP") (or Environ("TMP") - is the same)
result: C:\Users\omar\AppData\Local\Temp
Need to run an application after saving attachment with below script.
how do i call it After end sub?
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\New folder\tmp\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
To open Application in VBA
Sub OpenApp()
Dim x As Variant
Dim Path As String
'// Application Path
Path = "C:\Program Files\blabla.exe"
x = Shell(Path, vbNormalFocus)
End Sub
I have save attachment VBA code for Outlook. It doesn't process if I receive an attachment with the same name. How do overwrite and save the latest?
Sub ExportAttach(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Users\Redirection\johndoe\Desktop\TestFolder"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
One method would be: construct the destination file name first, check if the file exists, if yes delete the file and then save the file.
Dim FN as String
FN = SaveFolder & "\" & objAtt.DisplayName
if (Dir$(fn) <> "") then kill fn ' delete if file exists
objAtt.saveAsFile fn