Outlook Office 365 VBA download attachment

[kyoichi83]

Hi Dear,

I had a VBA script to download email attachment applying from rules. It work on Outlook 2010 (Windows 7) but when i try to apply the code on Outlook Office 365 (window 10) it doesn't seen to work at all. Could you kindly enlighten me? below is the code i used.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Archive\"
Dim SenderEmailAddress As String
SenderEmailAddress = itm.senderName & " "
Dim dateFormat As String
dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd hh-mm-ss-ms")
Dim dateFormat2 As String
dateFormat2 = Format(Now, "yyyy-mm-dd hh-mm-ss-ms")
Dim LRandomNumber As Integer
LRandomNumber = Int((9999 - 100 + 1) * Rnd + 100)


For Each objAtt In itm.Attachments
If InStr(objAtt.DisplayName, ".xml") Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & "_Recevie " & LRandomNumber & "_RandomNo " & ReplaceIllegalCharacters(SenderEmailAddress, "_") & dateFormat2 & "_Processed " & objAtt.DisplayName

End If
Next

End Sub

Function ReplaceIllegalCharacters(strIn As String, strChar As String) As String
Dim strSpecialChars As String
Dim i As Long
strSpecialChars = "~""#%&*:<>?{|}/\[]"

For i = 1 To Len(strSpecialChars)
strIn = Replace(strIn, Mid$(strSpecialChars, i, 1), strChar)
Next

ReplaceIllegalCharacters = strIn
End Function

 

[Diane Poremsky]

It should work on it too,. Do you have macro security set to low or sign the macro with a selfsig?

This folder exists? saveFolder = "C:\Archive\"

Test it by stepping though it -select a message then use this macro - use the Step into button and watch what it does.

Sub TestsaveAttachtoDisk()
Dim objApp As Outlook.Application
Dim objItem As Object ' MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
saveAttachtoDisk objItem

End Sub

 

[kyoichi83]

It should work on it too,. Do you have macro security set to low or sign the macro with a selfsig?

This folder exists? saveFolder = "C:\Archive\"

Test it by stepping though it -select a message then use this macro - use the Step into button and watch what it does.

Sub TestsaveAttachtoDisk()
Dim objApp As Outlook.Application
Dim objItem As Object ' MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
saveAttachtoDisk objItem

End Sub

Thank you! Marco had been set to low and folder exist too. I will try with your recommendation.