从Outlook中的电子邮件下载文件

时间:2018-10-19 16:53:34

标签: excel vba outlook

我想从过去一年中每天收到的电子邮件中下载Excel文件。

每封电子邮件都有一个Excel文件,并且除了日期(显示为'YYYYMMDD')以外,Excel文件的名称相同。

我在Outlook的一个文件夹中有包含Excel文件的邮件。我希望每个Excel文件都可以转到Outlook外部文件夹中的相应月份。

我有下载Excel文件的代码,但障碍很少:

  1. 宏只能运行一次,我需要它在循环中运行。

  2. 该宏在我的收件箱中查找未读的电子邮件,然后下载和关联的Excel文件。我希望宏要么A.查找主题中特定文本的电子邮件,要么B.下载已阅读的任何电子邮件的Excel文件。当我将代码从[UNREAD] = True更改为[READ] = True时,它中断了。

  3. 也许是最重要的,我希望将Excel文件保存到特定的月份文件夹中,具体取决于Excel文件上的日期。 (这是Outlook外部的文件夹)。

  4. 每次保存Excel文件时,宏都会保存一个单独的.pdf文件。 .pdf文件未显示任何内容。如果没有破坏但不是理想的。

Siddharth Rout产生的原始代码:(Download attachment from Outlook and Open in Excel

这是我正在使用的代码:

Sub Stack_Overflow_Test()

    Dim olapp As Object
    Dim olmapi As Object
    Dim olmail As Object
    Dim olitem As Object
    Dim lrow As Integer
    Dim olattach As Object
    Dim str As String

    Const num As Integer = 6
    Const path As String = "S:\Actg\sec\TESTING\Attachments from 
    Outlook\October\"
    Const emailpath As String = "S:\Actg\sec\TESTING\Attachments from 
    Outlook\October\"
    Const olFolderInbox As Integer = 6

    Set olp = CreateObject("outlook.application")
    Set olmapi = olp.getnamespace("MAPI")
    Set olmail = olmapi.getdefaultfolder(num)

    If olmail.items.restrict("[UNREAD]=True").Count = 0 Then

    MsgBox ("No Unread mails")

    Else

        For Each olitem In olmail.items.restrict("[UNREAD]=True")
            lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

            Range("A" & lrow).Value = olitem.Subject
            Range("B" & lrow).Value = olitem.senderemailaddress
            Range("C" & lrow).Value = olitem.To
            Range("D" & lrow).Value = olitem.cc
            Range("E" & lrow).Value = olitem.body

            If olitem.attachments.Count <> 0 Then

                For Each olattach In olitem.attachments

                    olattach.SaveAsFile path & olattach.Filename

                Next olattach

            End If
    str = olitem.Subject
    str = Replace(str, "/", "-")
    str = Replace(str, "|", "_")
    Debug.Print str
            olitem.unread = False
            DoEvents
        Next olitem

    End If

    ActiveSheet.Rows.WrapText = False

End Sub

1 个答案:

答案 0 :(得分:-1)

  1. 您可以设置宏规则,设置每天运行此脚本。

    请参考此链接来设置URL:

    Outlook's Rules and Alerts: Run a Script

  2. 设置[UNREAD] = false以获取已读电子邮件

  3. 您可以从Excel文件中找到特定日期,然后将其设置为“文件名”。

    有关更多信息,请参考此链接:

    Saving .XLSX Attachments from Outlook 2010 w/ VBA