使用Excel值保存电子邮件附件作为文件名的input

我有点新的编码，但在这里:)

我收到的电子邮件附件需要使用Excel工作表中的信息以特定的名称格式进行保存。

• 包含我需要的信息的行可以通过电子邮件的主题行进行标识。

我想编写一些代码来为Outlook中选定的电子邮件执行以下操作：

1. 使用电子邮件的主题行查找包含所需信息的行
2. 返回该行中几个字段的值
3. 使用这些值和主题行来创build一个文件名
4. 将文件保存在指定的目录中

我已经设法find并重写一些复制的代码来保存仅使用主题行作为文件名的附件。 我努力从Excel工作表获取信息追加到文件名。

这是我的代码到目前为止：

Sub SaveAttachments() Dim objOL As Outlook.Application Dim objMsg As Outlook.MailItem Dim objAttachments As Outlook.Attachments Dim objSelection As Outlook.Selection Dim i As Long Dim lngCount As Long Dim strFile As String Dim strFolderpath As String Dim strFileName As String Dim objSubject As String Dim strDeletedFiles As String strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) On Error Resume Next ' Instantiate an Outlook Application object. Set objOL = CreateObject("Outlook.Application") ' Get the collection of selected objects. Set objSelection = objOL.ActiveExplorer.Selection ' Set the Attachment folder. strFolderpath = "C:\Users\User\Documents\" ' Check each selected item for attachments. For Each objMsg In objSelection 'Set FileName to Subject objSubject = objMsg.Subject Set objAttachments = objMsg.Attachments lngCount = objAttachments.Count If lngCount > 0 Then ' Use a count down loop for removing items ' from a collection. Otherwise, the loop counter gets ' confused and only every other item is removed. For i = lngCount To 1 Step -1 ' Get the file name. strFileName = objSubject & ".pdf" ' Combine with the path to the Temp folder. strFile = strFolderpath & strFileName Debug.Print strFile ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile strFile Next i End If Next ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objSelection = Nothing Set objOL = Nothing End Sub 

我猜我需要编写一个函数来返回Excel表中的值，但我不知道该怎么做。

Answer 1

为了让代码尽可能地不混乱，我们来做一个函数来从Excel工作表中获取信息：

1. 使用电子邮件的主题行查找包含所需信息的行
2. 返回该行中几个字段的值
3. 使用这些值和主题行来创build一个文件名
4. 将文件保存在指定的目录中

假设主题行<255个字符，并且是唯一的（不重复），像这样：

 Function GetInfoFromWorksheet(ws as Worksheet, mail as Outlook.MailItem) ' Finds a subject in the worksheet and returns the concatenated ' values from several cells in that row ' worksheet: the sheet which contains the outlook info/details ' mail: the outlook mailitem being processed Dim row as Long Dim rng as Range Dim combinedValues as String Dim subject as String Dim ret As String subject = mail.Subject '#1 Find the subject in Column A, modify if needed Set rng = Application.Match(subject, ws.Range("A:A"), False) If not rng Is Nothing Then row = rng.Row Else ret = "" GoTo EarlyExit End If '#2, #3 Once we know the row, then you can pull out additional info ' from this row and combine them like so. ' Example combines column B and Column F, modify as needed: ret = ws.Cells(row, 2) & ws.Cells(row, 6) 'Etc EarlyExit: SaveAttachments = ret End Function 

从你的程序中，像这样调用它：

 For i = lngCount To 1 Step -1 ' Get the file name. strFileName = GetInfoFromWorksheet(ActiveSheet, objMsg) If strFileName = "" Then ' the function returns an empty string, then the subject wasn't found in Excel sheet MsgBox objMsg & " not found in Excel sheet!", vbInformation Else: 'the details were found in Excel, so save the file: strFileName = strFileName & ".pdf" ' Combine with the path to the Temp folder. strFile = strFolderpath & strFileName Debug.Print strFile ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile strFile End If Next 

注意：这可能不适用于具有多个附件的项目，因为与主题行相匹配的行对于每个附件都是相同的，因此它将返回相同的信息，最终每个附件的文件名相同。 你可以很容易的修改函数，或者你的调用过程把i值附加到文件名，这样可以确保每个附件的唯一名称。 喜欢：

  'the details were found in Excel, so save the file: strFileName = strFileName & Cstr(i) & ".pdf" 

另一个注意事项：摆脱On Error Resume Next ，正确处理错误…