Question

我对VBA很新，需要一些帮助。我尝试编写VBA脚本（以及Outlook规则）以自动从每日电子邮件中下载附件，并附加文件名以及主题中显示的日期。

这是主题行的样子 - ＆＃34;电子邮件警报部门2014年10月20日＆＃34;。我只需要隔离最右边的10个空格，指示文件的运行日期。

所以我发现在线代码可以自动下载附件，并按照当前日期附加功能。见下文。

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyymmdd ")
saveFolder = "Z:\Daily Emails"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

我也在网上发现这样的东西应该指向日期（格式为XX / XX / XXXX，并且总是在主题行的末尾。 Subject = Right（itm.Subject，10）但是我很难将它合并到上面的代码中。

任何人都可以帮助我吗？这意味着很多

谢谢！

-Christina

Answer 1

使用规则运行宏是很好的我之前使用过相同的设置。问题是如果你要处理新收到的邮件，那么sub就不会陷阱。如果您需要使用部门电子邮件警报mm / dd / yyyy 作为主题保存传入电子邮件的附件，请尝试使用事件。默认情况下，Outlook不提供项目事件，因此您必须创建它。

在 ThisOutlookSession （不在模块中）尝试类似的内容：

Option Explicit
Private WithEvents olIBoxItem As Outlook.Items

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder

    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    '~~> change olFolder depending on what folder you're receiving the email
    '~~> I assumed it is Outlook's default folder Inbox
    Set olIBoxItem = olFolder.Items
End Sub

Private Sub olIBoxItem_ItemAdd(ByVal Item As Object)
    Const strSub As String = "Email Alert for Department for "
    If TypeOf Item Is Outlook.MailItem Then
        Dim nMail As Outlook.MailItem
        Set nMail = Item

        If InStr(nMail.Subject, strSub) <> 0 Then
            Const savefolder As String = "Z:\Details Mail\"
            '~~> Extract your date
            Dim dateSub As String: dateSub = Right(nMail.Subject, 10)
            '~~> Make sure there is an attachment
            If nMail.Attachments.Count > 0 Then
                Dim olAtt As Outlook.Attachment
                Set olAtt = nMail.Attachments.Item(1) '~~> if you only have 1
                Dim attFName As String, addFExt As String
                '~~> Get the filename and extension separately
                attFName = Split(olAtt.Filename, ".")(0) 
                attFExt = Split(olAtt.Filename, ".")(1)
                '~~> Reconstruct the filename
                attFName = savefolder & attFName & " " & dateSub & attFExt
                '~~> Save the attachment
                olAtt.SaveAsFile attFName
            End If
        End If
    End If
End Sub

因此上述例程会自动检查收件箱文件夹中收到的任何邮件。
如果主题包含指定的字符串。如果是，它会自动保存附件但是，如果你有多个附件，你必须仔细查看它然后保存每个附件。
一开始可能看起来很混乱，但你肯定会得到它的悬念。 HTH。

保存Outlook附件并使用主题行中的标识符重命名/追加文件

1 个答案: