以下代码扫描我的收件箱,并将带有.csv附件的所有文件保存到桌面上的文件夹以及Outlook中的文件夹。
该代码可以很好地用作VBA,但是当我将其更改为脚本时,可以按规则运行它有错误。
我知道我需要在方括号中有Outlook.MailItem,但是我不确定应该将什么作为邮件项目。
Sub SaveAttachments(myItem As Outlook.MailItem)
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim avDate() As String
Dim vDate As String
Dim i As Long
Dim j As Long
Dim csvCount As Long
Dim myDestFolder As Outlook.MAPIFolder
Const myPath As String = "C:\Users\____\Desktop\Test Folder\"
ReDim Preserve avDate(3)
Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
i = 0
j = 0
Set myDestFolder = myFolder.Parent.Folders("CSV Emails")
For i = myFolder.Items.Count To 1 Step -1
If TypeName(myFolder.Items(i)) = "MailItem" Then
Set myItem = myFolder.Items(i)
End If
csvCount = 0
If myItem.UnRead = True Then
avDate = Split(CStr(myItem.ReceivedTime), "/")
vDate = Mid(avDate(2), 1, 4) & "-" & avDate(1) & "-" & avDate(0)
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
If LCase(Right(myAttachment.FileName, 3)) = "csv" Then
j = j + 1
csvCount = csvCount + 1
myAttachment.SaveAsFile ((myPath) & vDate & " - " & j & " - " & myAttachment.FileName)
End If
Next myAttachment
If csvCount > 0 Then
myItem.UnRead = False
myItem.Move myDestFolder
End If
End If
End If
Next i
SaveAttachments_exit:
Set myAttachment = Nothing
Set myItem = Nothing
Set myNameSpace = Nothing
Exit Sub
SaveAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume SaveAttachments_exit
End Sub
我只希望脚本在Outlook打开时运行。我已经创建了一个规则来执行此操作,我只是想解决最后一个错误!
如果有所不同,我仍然拥有名为SaveAttachments的VBA模块。
谢谢您的帮助!