Question

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

我很好奇的是，是否有可能

使用代码检查收到的电子邮件，看看他们是否有附件，
然后检查附件以查看它是否是.XLSX，
如果是，请打开附件，检查特定单元格的值，
然后将帐户名称和帐号存储为字符串和变量
然后使用它们在相应的Windows目录中创建子文件夹。

**我忘了发布到目前为止我所做的事情。我相信布雷特回答了我的问题，但也许其他人可以使用它的片段。

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

End Sub

Answer 1

说这里很漫长是一种方法。来自VBA Code to save an attachment (excel file) from an Outlook email that was inside another email as an attachment的我的代码也可能是有意义的

您需要更新文件路径以及正在打开的文件的单元格区域

在我的测试中，我向自己发送了一条消息，其中包含一个pdf文件和一张excel工作簿，在第一页的A1中有“bob”

下面的代码找到了excel文件，保存了它，打开它，创建了一个目录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

从Outlook 2010保存带有VBA的.XLSX附件

1 个答案: