关于 excel：VBA 从具有多个帐户的电子邮件中保存附件(基于定义的标准)


VBA to save attachments (based on defined criteria) from an email with multiple accounts

情况：我有一个代码，如果输入发件人电子邮件，它将从 Outlook 电子邮件中下载所有附件(如果发件人是指定的发件人，它会保存 .xls 附件)。

问题 1：在我的前景中，我可以访问 2 个帐户(比如说个人帐户和公共帐户)。我希望能够选择代码应从哪些帐户中下载附件。

问题一：这样的选择可以吗？从之前的研究中，我能够找到关于附件类型的标准等等，但没有关于多个收件箱的标准。

问题 2：在第二个收件箱(公共)的附件中，我只想选择具有特定 "NAME" 的工作表的文件。我知道如何做一个 if 来解决这个问题，但不知道它是否可以读取文件(并检查它是否有想要的表)然后才下载它。

问题 2：我可以访问这样的文件吗？是否可以进行这种标准检查？

到目前为止的代码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub email()

Application.ScreenUpdating = False

On Error Resume Next

Dim olApp As New Outlook.Application
Dim olNameSpace As Object
Dim olMailItem As Outlook.MailItem
Dim olFolder As Object
Dim olFolderName As String
Dim olAtt As Outlook.Attachments
Dim strName As String
Dim sPath As String
Dim i As Long
Dim j As Integer
Dim olSubject As String
Dim olSender As String
Dim sh As Worksheet
Dim LastRow As Integer

ThisWorkbook.Worksheets("FileNames").Rows(2 &":" & ThisWorkbook.Worksheets("FileNames").Rows.count).Delete

olFolderName = ThisWorkbook.Worksheets("Control").Range("D10")
olSender = ThisWorkbook.Worksheets("Control").Range("D16")

sPath = Application.FileDialog(msoFileDialogFolderPicker).Show
sPathstr = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

Set olNameSpace = olApp.GetNamespace("MAPI")

'check if folder is subfolder or not and choose olFolder accordingly
Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox).Folders(olFolderName)
If (olFolder ="") Then
    Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders(olFolderName)
End If

'loop through mails
h = 2
For i = 1 To olFolder.Items.count
    Set olMailItem = olFolder.Items(i)

    If (InStr(1, olMailItem.SenderEmailAddress, olSender, vbTextCompare) <> 0) Then

        With olMailItem

            'loop through attachments
            For j = 1 To .Attachments.count

                strName = .Attachments.Item(j).DisplayName

                'check if file already exists
                If Not Dir(sPathstr &"" & strName) ="" Then
                .Attachments(j).SaveAsFile sPathstr &"" &"(1)" & strName
                ThisWorkbook.Worksheets("FileNames").Range("A" & h) ="(1)" & strName
                Else
                .Attachments(j).SaveAsFile sPathstr &"" & strName
                ThisWorkbook.Worksheets("FileNames").Range("A" & h) = strName
                End If

                h = h + 1
            Next

        End With

    End If
Next

Application.ScreenUpdating = True
MsgBox"Download complete!", vbInformation + vbOKOnly,"Done"

End Sub
相关讨论

Outlook 中的每个文件夹都有唯一的路径。即使它们都称为收件箱，它们的路径也不同。选择 Outlook 中的第一个收件箱并转到即时窗口(Alt F11 然后 Ctrl G)。输入这个并按回车

1
?application.ActiveExplorer.CurrentFolder.FolderPath

你会得到类似

的东西

1
\\\\[email protected]\\Inbox

现在返回 Outlook 并选择另一个收件箱。返回立即窗口并执行相同的命令。现在您将获得每个收件箱的路径。也许第二个看起来像

1
\\\\DKPersonal\\Inbox

你使用GetDefaultFolder，非常方便。但是您可以直接按照路径访问任何文件夹，甚至是默认文件夹。

1
Set olFolder = Application.GetNamespace("MAPI").Folders("[email protected]").Folders("Inbox")

只需将 Folders 个属性链接在一起，直到获得所需的属性。

至于问题 2，您无法在不打开 Excel 文件的情况下对其进行检查。您必须将其下载到一个临时位置，打开它以查看它是否包含工作表，如果包含，则将其移动到最终位置。或者将其下载到最终位置，如果没有工作表则将其删除。

相关讨论