I tried to approach my goal using in-build Outlook rules however without success so I decide to use VBA script but it is not also working properly.
Scenario: Every 1h I am reciving email with report in xls format, which need to be saved on share folder. Every 1h report can be overridden by new one. I don't need any date and time in file name just save file which was received.
I have dedicated sub folder in inbox, where all emails which contains in topic string "Sales Report" have to be moved. I tried to create rule - when email is recive then move it to subfolder, and afterward run VBA scrip which allows to save attachment. However it is not working as sometimes instead of saving xls file, script is saving file "ATP Scan In Progress". Looks like script is saving xls file before file was scanned by in-built Outlook scanner.
Is there any way to delay saving xls until scan will be completed, or there is any other way to aproach my goal.
Thank you for support.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "\\reports\jon\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
Something like this should work...
In ThisOutlookSession
Private WithEvents ReportItems As Outlook.Items
Private Sub Application_Startup()
On Error Resume Next
With Outlook.Application
Set ReportItems = .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Sales Reports").Items
End With
End Sub
Private Sub ReportItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) = "MailItem" Then Call SaveXLSAttachments(Item, "\\reports\jon\")
End Sub
In a module
Sub SaveXLSAttachments(ByVal Item As Object, FilePath As String)
Dim i As Long, FileName As String, Extension As String
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
Delay(5) 'If required
Extension = ".xls"
With Item.Attachments
If .Count > 0 Then
For i = 1 To .Count
FileName = FilePath & .Item(i).FileName
If LCase(Right(FileName, Len(Extension))) = Extension Then .Item(i).SaveAsFile FileName
Next i
End If
End With
End Sub
Function Delay(Seconds As Single)
Dim StopTime As Double: StopTime = Timer + Seconds
Do While Timer < StopTime
DoEvents
Loop
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.