access开发一键批量下载Outlook附件

hi，大家好！

暑假快到了，不知道大家有没有想好去哪里放松一下？如果还没有头绪，不妨来江苏体验一下苏超，感受绿茵场上的热血和魅力。走进球场，不仅能为球队加油助威，更能体验那种全场沸腾的氛围，如果买不到门票，不如来品尝一下周边城市的风味美食，来一场美景和美食融合的“足球之旅”。

OK，回到工作话题，上一篇文章，我们讲了outlook简单的应用，今天我们接着来讲讲access结合outlook的操作！

各位牛马，是不是每天要收好多的邮件？邮件里是不是还有好多的附件？你有没有想过，如果能一次性下载所有的附件该多好，就不用再手工一个一个的点了，答案当然是可以的，这样一来，事情越多，反而越能展现出自动化与效率提升的优势，让日常工作更加轻松、高效。同为牛马的我们时时刻刻都在想在如何提升工作效率！

01创建窗体

第一步，我们先创建一下窗体，在窗体上放一个按钮就可以了，像这样：

02添加代码

接着，我们就可以来添加代码了：
 

Private Sub Command0_Click()
    Dim myOlApp As Object          ' Outlook.Application
    Dim myNamespace As Object      ' Outlook.Namespace
    Dim myFolder As Object         ' Outlook.Folder
    Dim myMailItem As Object       ' Outlook.MailItem
    Dim att As Object              ' Outlook.Attachment
    
    Dim folderPath As String
    Dim myFilter As String
    
    ' 示例：可将筛选内容改为你需要的关键字或条件
    myFilter = ""
    
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        .Title = "Please select the target folder"
        If .Show Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "请选择一个文件夹", vbExclamation
            Exit Sub
        End If
    End With
    
    On Error GoTo ErrHandler
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    ' 6 指代 olFolderInbox
    Set myFolder = myNamespace.GetDefaultFolder(6)
    
    For Each myMailItem In myFolder.Items
        ' 如果需要仅对未读邮件处理，则保留该判断
        If myMailItem.UnRead Then
            ' InStr 返回 0 表示未匹配到
            If InStr(1, myMailItem.subject, myFilter, vbTextCompare) > 0 Then
                myMailItem.UnRead = False
                If myMailItem.Attachments.Count > 0 Then
                    Dim savePath As String
                    For Each att In myMailItem.Attachments
                        savePath = folderPath & "\" & myMailItem.subject & "-" & att.FileName
                        att.SaveAsFile savePath
                    Next att
                Else
                    MsgBox myMailItem.SenderEmailAddress & "：无附件"
                End If
            End If
        End If
    Next myMailItem
    
    MsgBox "附件下载完成！", vbInformation
    Exit Sub
ErrHandler:
    MsgBox "出现错误：" & Err.Description, vbExclamation
End Sub

代码里面读取的是“未读邮件”的数据，你也可以改一下，比如只读取某个地址的附件：

If myMailItem.SenderEmailAddress = "someone@domain.com" Then

03运行测试

最后，就是运行测试一下，注意，测试的时候是要先准备邮件的，且你的邮件是要未读的！比如：

有了测试的邮件就可以来读取了，结果我就给大家截个图吧。

好了，大家快去测试一下吧！