Question

基本问题 - 我有一个脚本可以保存Outlook中选定电子邮件的附件，我希望它在进入时自动保存附件（我会在Outlook中创建一条规则来运行脚本时发送电子邮件进来），任何帮助将不胜感激！

Public Sub script()

Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim itm As Outlook.MailItem
Dim dateFormat
    dateFormat = Format(Now, "yymmdd ")

saveFolder = "C:\temp"
For Each itm In ActiveExplorer.Selection
    For Each objAtt In itm.Attachments
     If objAtt.Size > 5200 Then
       objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
        Set objAtt = Nothing
        End If
    Next objAtt
Next itm
End Sub

Answer 1

您需要传递一个项目作为参数。因此，代码应如下所示：

Public Sub script(itm as Outlook.MailItem)
    Dim saveFolder As String
    Dim objAtt As Outlook.attachment
    Dim dateFormat

    dateFormat = Format(Now, "yymmdd ")
    saveFolder = "D:\temp"
    For Each objAtt In itm.Attachments
       If objAtt.Size > 5200 Then
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
          Set objAtt = Nothing
       End If
    Next objAtt
End Sub

并且不要在C：驱动器上保存附件，它需要最新Windows操作系统的管理员权限。选择其他驱动器/文件夹。

Answer 2

我不确定您是否可以使用规则。我想你需要连接一个Outlook事件。为此，您将使用以下代码;

Private WithEvents olItems As Outlook.Items

Private Sub Application_Startup()

   Dim olApp As Outlook.Application 
   Dim objNS As Outlook.NameSpace 
   Set olApp = Outlook.Application 
   Set objNS = olApp.GetNamespace("MAPI") 
   ' this is for your local Inbox - if you have more inboxes you need to set it for each one
   Set olItems = objNS.GetDefaultFolder(olFolderInbox).Items

End Sub

'You can add this because you used "WithEvents" to declare olItems
Private Sub olItems_ItemAdd(ByVal item As Object) 

  Dim olMailItem As Outlook.MailItem
 'this event will fire for all items so you need to make sure you have a mail item.
  If TypeName(item) = "MailItem" Then
    Set olMailItem = item 
    Dim saveFolder As String
    Dim objAtt As Outlook.attachment
    Dim dateFormat
    dateFormat = Format(Now, "yymmdd ")
    saveFolder = "D:\temp"

    For Each objAtt In olMailItem.Attachments
      If objAtt.Size > 5200 Then
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
        Set objAtt = Nothing
      End If
    Next objAtt    
End If

End Sub

将脚本从选定邮件更改为传入邮件

2 个答案: