Question

我一直在尝试找到一个脚本，用于将附件保存到我们网络上的文件夹中。我终于有了一些工作，但看起来它不适用于我的第二个系统，恰好是Outlook 2010.我不能肯定是否因为这个差异。

代码是：

Sub SaveAllAttachments(objItem As MailItem)
    Dim objAttachments As Outlook.Attachments
    Dim strName, strLocation As String
    Dim dblCount, dblLoop As Double

    strLocation = "C:\test\"

    On Error GoTo ExitSub
    If objItem.Class = olMail Then
       Set objAttachments = objItem.Attachments
       dblCount = objAttachments.Count
       If dblCount <= 0 Then
           GoTo 100
       End If
       For dblLoop = 1 To dblCount
           strID = " from " & Format(Date, "mm-dd-yy")           'Append the Date
           'strID = strID & " at " & Format(Time, "hh`mm AMPM") 'Append the Time
           ' These lines are going to retrieve the name of the
           ' attachment, attach the strID to it to insure it is
           ' a unique name, and then insure that the file
           ' extension is appended to the end of the file name.
           strName = objAttachments.Item(dblLoop).Filename 'Get attachment name
           strExt = Right$(strName, 4)                     'Store file Extension
           strName = Left$(strName, Len(strName) - 4)      'Remove file Extension
           strName = strName & strID & strExt              'Reattach Extension
           ' Tell the script where to save it and
           ' what to call it
           strName1 = strLocation & "PDF\" & strName                 'Put it all together
           strName2 = strLocation & "JPG\" & strName                 'Put it all together
           ' Save the attachment as a file.
           objAttachments.Item(dblLoop).SaveAsFile strName1
           objAttachments.Item(dblLoop).SaveAsFile strName2
        Next dblLoop
        objItem.Delete
    End If
100
ExitSub:
    Set objAttachments = Nothing
    Set objOutlook = Nothing
End Sub

Answer 1

目前您正在使用的Outlook版本并不重要。代码应该正确地工作。

可行的原因：

我建议选择其他位置来保存文件。 C：驱动器需要最新操作系统的管理员权限。
未触发规则。
脚本中的错误。尝试从其他VBA sub手动调用脚本，看看幕后发生了什么。你在代码中得到任何错误吗？

Visual Basic脚本不适用于Outlook 2010规则

1 个答案: