使用单元格值作为文件名保存 Outlook 附件

Posted 2023-03-27

【中文标题】使用单元格值作为文件名保存 Outlook 附件

【英文标题】：Save Outlook attachment using a cell value as the file name

【发布时间】：2022-01-14 14:33:51

【问题描述】：

我正在尝试将特定子文件夹中的 Outlook 附件保存到本地路径。

我可以将文件按原样保存到本地路径。

要求是使用 ThisWorkbook 的单元格值作为文件名来保存 xl 附件。

Sub ManualPunchAttachmentsExtract()
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlMail As Object
    Dim OlApp As Outlook.Application
    Dim OlItems As Outlook.Items
    Dim Get_namespace As Outlook.Namespace
    Dim strFolder As String
    Dim i As Integer
    
    ThisWorkbook.Activate
    Sheets("MP File Save").Activate
    Range("H3").Activate
    
    Set OlApp = GetObject(, "Outlook.Application")
    
    If err.Number = 429 Then
        Set OlApp = CreateObject("Outlook.Application")
    End If
    
    strFolder = InputBox("Please Enter the Folder Path alongwith ' \ ' at the end", Path)
    
    'Set Get_namespace = OlApp.GetNamespace("MAPI")
    Set OlFolder = OlApp.GetNamespace("MAPI").Folders("[e-mail]").Folders("Archive").Folders("Juarez").Folders("Manual Punch")
    Set OlItems = OlFolder.Items
    '.Restrict("[Unread]=true")
    
    For Each OlMail In OlItems
    
        If OlMail.UnRead = False Then
             
        Else
            ThisWorkbook.Activate
            Sheets("MP File Save").Activate
            ActiveCell.Value = OlMail.Subject
            ActiveCell.Offset(0, 1).Value = OlMail.ReceivedTime
            
            If OlMail.attachments.Count > 0 Then
                For i = 1 To OlMail.attachments.Count
                    OlMail.attachments.Item(i).SaveAsFile strFolder & "\" & OlMail.attachments.Item(i).FileName
                    OlMail.UnRead = False
                    ThisWorkbook.Activate
                    ActiveCell.Offset(1, 0).Select
                Next i
            
            Else
            
            End If
         End If
    Next
MsgBox ("Done")
End Sub

【问题讨论】：

代码没有问题，但要求是将outlook附件直接保存到本地路径，但文件名使用excel文件中可用的单元格值。我只是无法根据需要使用文件名保存文件。

好的。基本上这个想法是将电子邮件的主题行和记录时间保存在宏工作簿的工作表中，并将这两个信息合并以形成一个“文件名”。如果我按原样运行此代码，它会将上述信息保存到宏 WB，并且还将 Outlook 附件保存到给定的本地路径。但是当 Outlook 附件保存到本地路径时，我无法使用“合并文件名”。相反，它保存在显示名称中，而不是合并的名称中。我试图用谷歌搜索这种特殊的方法，但没有成功。任何支持将不胜感激。

【参考方案1】：

首先，遍历 Outlook 文件夹中的所有项目并不是一个好主意。请改用 Items 类的 Find/FindNext 或 Restrict 方法。所以，而不是下面的代码：

For Each OlMail In OlItems

     If OlMail.UnRead = False Then

使用这个：

Private Sub FindAllUnreadEmails(folder As Outlook.MAPIFolder)

    Dim searchCriteria As String = "[UnRead] = true"
    Dim counter As Integer = 0
    Dim mail As Outlook._MailItem = Nothing
    Dim folderItems As Outlook.Items = Nothing
    Dim resultItem As Object = Nothing
   
        If (folder.UnReadItemCount > 0) Then
            
            folderItems = folder.Items
            resultItem = folderItems.Find(searchCriteria)
            While Not IsNothing(resultItem)
                If (TypeOf (resultItem) Is Outlook._MailItem) Then
                    counter += 1
                    mail = resultItem
                    Debug.Print("#" + counter.ToString() + _
                                          " - Subject: " + mail.Subject)
                End If
                resultItem = folderItems.FindNext()
            End While
            
        Else
            Debug.Print("There is no match in the " + _
                                   folder.Name + " folder.")
        End If
End Sub

注意，附件可以具有相同的文件名。因此，为了唯一标识文件，我建议在将附件保存到磁盘时在文件名中引入任何 ID。

最后，要使用工作簿的内容名称保存附件，您需要将单元格值传递给 SaveAsFile 方法：

OlMail.attachments.Item(i).SaveAsFile strFolder & "\" & yourWorksheet.Range("B2").Value

【讨论】：

万岁！！！完美运行非常感谢你.....