重命名并保存Outlook中的附件

时间:2017-05-16 15:35:39

标签: vba email outlook outlook-vba

我尝试使用Outlook规则保存附件,并将其重命名为电子邮件正文中的单词。

这个词位于冒号后的第三行。

我有一个运行此脚本的规则集。

Public Sub saveAttachtoNet(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "O:\EUROMKTG\Marketing Analytics Dept\Campaign 
Reporting\Campaign Dashboard\1. Exact Target (Salesforce Mrktg Cloud)"
 For Each objAtt In itm.Attachments
      objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
      Set objAtt = Nothing
 Next
End Sub

Email Body

2 个答案:

答案 0 :(得分:1)

在没有看到一些示例电子邮件的情况下,但在启动For Each objAtt..循环之前,您想要“抓住”这个词是很棘手的。我会在itm.Body寻找。如果您使用Split来解决Chr(13) - 回车,那么您只需要选择第3个'填充'段。您需要确信第3行将包含有效的文件名等,但请参阅下面的未经测试的了解如何执行此操作:

Public Sub saveAttachtoNet(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim bodystring, sgmnt As String
    Dim sgmntcounter As Integer
    saveFolder = "O:\EUROMKTG\Marketing Analytics Dept\Campaign " _
    & "Reporting\Campaign Dashboard\1. Exact Target (Salesforce Mrktg Cloud)"

    bodystring = itm.Body
    bodysegments = Split(bodystring, Chr(13))

    For Each sgmnt In bodysegments
        If sgmnt <> "" Then sgmntcounter = sgmntcounter + 1
        If sgmntcounter = 3 Then Exit For
    Next

    For Each objAtt In itm.Attachments
         objAtt.SaveAsFile saveFolder & "\" & sgmnt
         Set objAtt = Nothing
    Next
End Sub

答案 1 :(得分:1)

我这样做:

Public Sub saveAttachtoNet(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "O:\EUROMKTG\Marketing Analytics Dept" & _
                    "\Campaign Reporting\Campaign Dashboard" & _
                    "\1. Exact Target (Salesforce Mrktg Cloud)"

    Dim JobTxtInMail As String
    JobTxtInMail = "Exported for - JobID:"
    Dim StrStart As Integer
    StrStart = InStr(1, _
                    itm.Body, _
                    JobTxtInMail, _
                    vbTextCompare) + Len(JobTxtInMail) + 1
    Dim JobNum As String
    JobNum = Trim(Mid(itm.Body, _
                    StrStart, _
                    InStr(StrStart + 1, itm.Body, Chr(13)) - StrStart - 1))

    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & JobNum & "__" & objAtt.DisplayName
        Set objAtt = Nothing
    Next objAtt
End Sub

您可能需要分别在+ 1- 1中稍微调整一下StrStartJobNum

并更改objAtt.SaveAsFile以适合所需的输出!