VBA to save attachments (based on defined criteria

2019-09-15 05:41发布

Situation: I have a code that, given an input of sender email, will download all attachments from outlook email (if the sender is the one specified, it saves the .xls attachments).

Problem 1: In my outlook, I have access to 2 accounts (lets say personal and public). I want to be able to select from which of those accounts the code should download the attachments.

Question 1: Is it possible to do this kind of selection? From previous research I was able to find criteria regarding the type of attachments, and more, but nothing regarding multiple inboxes.

Problem 2: Among the attachments in this second inbox (public) I want to select only the files which have a worksheet with a certain "NAME". I know how to do an if to account for that, but don't know if its possible to read the file (and check if it has the wanted sheet) and only then download it.

Question 2: Could I access a file like this? Would it be possible to do this kind of criteria check?

Code so far:

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

1条回答
forever°为你锁心
2楼-- · 2019-09-15 06:14

Every folder in Outlook has a unique path. Even if they're both called Inbox, the path to them is different. Select the first Inbox in Outlook and go to the Immediate Window (Alt+F11 then Ctrl+G). Type this and press enter

?application.ActiveExplorer.CurrentFolder.FolderPath

You'll get something like

\\dkusleika@copmany.com\Inbox

Now go back to Outlook and select the other Inbox. Return to the Immediate Window and execute the same command. Now you'll have the path to each Inbox. Maybe the second one looks like

\\DKPersonal\Inbox

You use GetDefaultFolder, which is very handy. But you can get to any folder, even default folders, by following their path directly.

Set olFolder = Application.GetNamespace("MAPI").Folders("dkusleika@company.com").Folders("Inbox")

Just chain Folders properties together until you get to the one you want.

As for Question 2, you can't inspect an Excel file without opening it. You'll have to download it to a temporary location, open it to see if it contains the worksheet, and move it to the final location if it does. Or download it to the final location and delete it if it doesn't have the sheet.

查看更多
登录 后发表回答