首页 文章

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

提问于
浏览
2

我们使用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

结束子

1 回答

  • 3

    说这里很冗长是一种方法 . 我的代码来自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
    

相关问题