从Outlook 2010 w / VBA保存.XLSX附件

我们使用Outlook 2010并接收带有Excel附件的电子邮件。 我们手动将附件保存在我们在networking驱动器上的分区文件夹中创build的子文件夹中。

我很好奇的是，如果有可能的话

1. 使用代码检查传入的电子邮件，看他们是否有附件，
2. 然后检查附件，看它是否是.XLSX，
3. 如果是这样，打开附件，检查特定单元格的值，
4. 然后将帐户名称和帐户号码存储为string和variables
5. 然后使用它们在相应的Windows目录中创build子文件夹。

**我忘了发布我迄今为止所做的。 我相信布雷特回答了我的??，但也许别人可以使用它的片段。

Private Sub cmdConnectToOutlook_Click() Dim appOutlook As Outlook.Application Dim ns As Outlook.Namespace Dim inbox As Outlook.MAPIFolder Dim item As Object Dim atmt As Outlook.Attachment Dim filename As String Dim i As Integer Set appOutlook = GetObject(, "Outlook.Application") Set ns = appOutlook.GetNamespace("MAPI") Set inbox = ns.GetDefaultFolder(olFolderInbox) i = 0 If inbox.Items.Count = 0 Then MsgBox "There are no messages in the Inbox.", vbInformation, _ "Nothing Found" Exit Sub End If For Each item In inbox.Items For Each atmt In item.Attachments If Right(atmt.filename, 4) = "xlsx" Then filename = "\\temp\" & atmt.filename atmt.SaveAsFile filename i = i + 1 End If Next atmt Next item MsgBox "Attachments have been saved.", vbInformation, "Finished" Set atmt = Nothing Set item = Nothing Set ns = Nothing 

结束小组

Answer 1

说了这么长时间，这是一个办法。 我从VBA代码的代码保存附件（excel文件）从另一封电子邮件作为附件的Outlook电子邮件也可能是感兴趣的

您将需要更新您的文件path，以及您打开的文件的单元格范围

在我的testing中，我给自己发送了一个pdf文件和一个excel工作簿，在第一张A1的“bob”

下面的代码find了excel文件，保存，打开它，创build一个目录c:\temp\bob然后杀死保存的文件

 Private Sub Application_NewMailEx _ (ByVal EntryIDCollection As String) 'Uses the new mail techniquer from http://www.outlookcode.com/article.aspx?id=62 Dim arr() As String Dim lngCnt As Long Dim olAtt As Attachment Dim strFolder As String Dim strFileName As String Dim strNewFolder Dim olns As Outlook.NameSpace Dim olItem As MailItem Dim objExcel As Object Dim objWB As Object 'Open Excel in the background Set objExcel = CreateObject("excel.application") 'Set working folder strFolder = "c:\temp" On Error Resume Next Set olns = Application.Session arr = Split(EntryIDCollection, ",") On Error GoTo 0 For lngCnt = 0 To UBound(arr) Set olItem = olns.GetItemFromID(arr(lngCnt)) 'Check new item is a mail message If olItem.Class = olMail Then 'Force code to count attachments DoEvents For Each olAtt In olItem.Attachments 'Check attachments have at least 5 characters before matching a ".xlsx" string If Len(olAtt.FileName) >= 5 Then If Right$(olAtt.FileName, 5) = ".xlsx" Then strFileName = strFolder & "\" & olAtt.FileName 'Save xl attachemnt to working folder olAtt.SaveAsFile strFileName On Error Resume Next 'Open excel workbook and make a sub directory in the working folder with the value from A1 of the first sheet Set objWB = objExcel.Workbooks.Open(strFileName) MkDir strFolder & "\" & objWB.sheets(1).Range("A1") 'Close the xl file objWB.Close False 'Delete the saved attachment Kill strFileName On Error Goto 0 End If End If Next End If Next 'tidy up Set olns = Nothing Set olItem = Nothing objExcel.Quit Set objExcel = Nothing End Sub