我的SaveAttachments脚本开头的括号应该是什么?

时间:2019-05-09 15:13:32

标签: vba outlook outlook-vba

以下代码扫描我的收件箱,并将带有.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模块。

谢谢您的帮助!

0 个答案:

没有答案