I wrote this code on an other PC which had Win10 and Office 2016. It is used in an outlook rule. It saves the xml files from the e-mail to a folder and change it to xlsx file in an other folder. In Outlook 2016 it runs properly. I copied it to an other notebook.
This notebook has Win10 and Office 2013 and this code run in Outlook 2013 without any error message but the xml files neither were saved into the given folder and nor were converted to xlsx.
What could be wrong in this code?
Option Explicit
Public Sub saveconvAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat As String
Dim convFormat As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
saveFolder = "C:\Users\tulaj\Documents\xml\"
convFolder = "C:\Users\tulaj\Documents\xls\"
dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd HH-mm-ss")
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & dateFormat & objAtt.FileName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(saveFolder)
If UCase(Right(objAtt.FileName, Len(XML))) = UCase(XML) Then
NewFileName = convFolder & dateFormat & objAtt.FileName & "_conv.xlsx"
Set ConvertThis = Workbooks.Open(saveFolder & dateFormat & objAtt.FileName)
ConvertThis.SaveAs FileName:=NewFileName, FileFormat:= _
xlOpenXMLWorkbook
ConvertThis.Close
End If
Next
Set objAtt = Nothing
End Sub
In Tools-References are selected the falowings:
Visual Basic For Aplications
Microsoft Outlook 15.0 Object Library
OLE Automation
Microsoft Office 15.0 Object Library
Microsoft Excel 15.0 Object Library
Microsoft Scripting Runtime
This should work for you...
Option Explicit
Public Sub saveconvAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim SaveFolder As String
Dim convFolder As String
Dim DateFormat As String
Dim ConvFormat As String
Dim NewFileName As String
Dim ConvertThis As Object
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
SaveFolder = "C:\Temp\xml\"
convFolder = "C:\Temp\xls\"
DateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd HH-mm-ss ")
For Each objAtt In itm.Attachments
Debug.Print objAtt.FileName
objAtt.SaveAsFile SaveFolder & DateFormat & objAtt.FileName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(SaveFolder)
If UCase(Right$(objAtt.FileName, Len("XML"))) = UCase("XML") Then
NewFileName = convFolder & DateFormat & objAtt.FileName & "_conv.xlsx"
Set ConvertThis = Workbooks.Open(SaveFolder & DateFormat & objAtt.FileName)
ConvertThis.SaveAs FileName:=NewFileName, FileFormat:= _
xlOpenXMLWorkbook
ConvertThis.Close
End If
Next
Set objAtt = Nothing
End Sub
To Test it, select the Email and run the following code
Public Sub Test_Rule()
Dim Item As MailItem
Set Item = ActiveExplorer.Selection.Item(1)
saveconvAttachtoDisk Item
Set Item = Nothing
End Sub
Related
I'm trying to save the daily system generated report attached to the e-mail to a folder.
Then, append the attachment filename with the date (modified date in the file). I am able to get the file saved to a folder. However, the renaming piece doesn't seem to work for me.
Can someone please help why the renaming piece isn't working? Much Thanks!
Public Sub saveAttachtoBIFolder(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName As Object
Dim file As String
Dim DateFormat As String
Dim newName As Object
saveFolder = "C:\BI Reports"
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each objAtt In itm.Attachments
file = saveFolder & "\" & objAtt.DisplayName
objAtt.SaveAsFile file
Debug.Print "file="; file ' the full file path printed on immediate screen
Set oldName = fso.GetFile(file) ' issue seems to start from here
DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
newName = DateFormat & objAtt.DisplayName
oldName.Name = newName
Debug.Print "DateFormat="; DateFormat 'the date format printed on the immediate screen
Set objAtt = Nothing
Next
Set fso = Nothing
End Sub
Your newName needs to be string NOT Object so Dim newName As String also I would assign objAtt.DisplayName to string variable
See Example
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each objAtt In itm.Attachments
File = saveFolder & "\" & objAtt.DisplayName
objAtt.SaveAsFile File
Debug.Print File ' the full file path printed on immediate screen
Set oldName = FSO.GetFile(File) ' issue seems to start from here
Debug.Print oldName
Dim newName As String
Dim AtmtName As String
AtmtName = objAtt.DisplayName
Debug.Print AtmtName
DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
Debug.Print DateFormat
newName = DateFormat & " " & AtmtName
oldName.Name = newName
Debug.Print newName 'the date format printed on the immediate screen
Next
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
Basic question - I have a script that saves attachments from selected emails in outlook, I want it to save the attachments automatically when they come in instead (I'll create a rule in outlook to run the script when an email comes in), any help would be appreciated!
Public Sub script()
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim itm As Outlook.MailItem
Dim dateFormat
dateFormat = Format(Now, "yymmdd ")
saveFolder = "C:\temp"
For Each itm In ActiveExplorer.Selection
For Each objAtt In itm.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next objAtt
Next itm
End Sub
You need to pass an item as a parameter. So, the code should look like the following one:
Public Sub script(itm as Outlook.MailItem)
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim dateFormat
dateFormat = Format(Now, "yymmdd ")
saveFolder = "D:\temp"
For Each objAtt In itm.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next objAtt
End Sub
And don't save attachments on the C: drive, it requires admin privileges on the latest Windows OS. Choose another drive/folder.
I am not sure that you can use a rule for this. I think you will need to hook up an Outlook event. To do this you would use code like the following;
Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' this is for your local Inbox - if you have more inboxes you need to set it for each one
Set olItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
'You can add this because you used "WithEvents" to declare olItems
Private Sub olItems_ItemAdd(ByVal item As Object)
Dim olMailItem As Outlook.MailItem
'this event will fire for all items so you need to make sure you have a mail item.
If TypeName(item) = "MailItem" Then
Set olMailItem = item
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim dateFormat
dateFormat = Format(Now, "yymmdd ")
saveFolder = "D:\temp"
For Each objAtt In olMailItem.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next objAtt
End If
End Sub
I am getting the following error on the script below, I'm trying to set up a script that will run when activated by an outlook rule (i.e. Apply this rule after message arrives; from person#email.com; run a script) and save any attachments to a particular folder.
runtime error '91' Object variable With block variable not set
the error is against 'For Each objAtt In itm.Attachments'
Public Sub script()
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim itm As Outlook.MailItem
Dim dateFormat
dateFormat = Format(SentOn, "yymmdd ")
saveFolder = "C:\temp"
For Each objAtt In itm.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next
End Sub
You didn't initialize the itm object. Try to define it as a parameter to a method in the following way:
Public Sub script(itm as Outlook.MailItem)
I am trying to download the attachment from a subject specified e-mail.
If Msg.Subject = "CALENDAR-EVENT" Then
'Download the attachment
Dim itmAttach As Outlook.MailItem
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\events\"
Dim dateFormat As String
dateFormat = Format(itmAttach.ReceivedTime, "yyyy-mm-dd Hmm ")
For Each objAtt In itmAttach.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Next
End if
I get the error:
91 object variable or with block variable not set
Maybe there is some error with the line:
Dim itmAttach As Outlook.MailItem
It also would be nice to get the downloaded file's name.
I did not use the outlook APIs before, neither did I touch VBA for years, but by the looks of it you meant this:
If Msg.Subject = "CALENDAR-EVENT" Then
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\events"
Dim dateFormat As String
dateFormat = Format(Msg.ReceivedTime, "yyyy-mm-dd Hmm ")
For Each objAtt In Msg.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Next
End if
Error 91 seems to be VBA's NullReferenceException.