Сохранение вложений .XLSX из Outlook 2010 с VBA

Question

Мы используем Outlook 2010 и получаем электронные письма с вложениями Excel. Мы вручную сохраняем вложение в подпапке, которую мы создаем в папке разделов на сетевом диске.

Что мне любопытно, если это возможно

1. Использование кода для проверки входящих сообщений электронной почты, чтобы увидеть, если у них есть вложение,
2. Затем проверьте крепление, чтобы увидеть если это .XLSX,
3. Если да, то открыть вложение, проверьте значение конкретной ячейки,
4. затем сохранить имя учетной записи и номер счета в виде строки и переменные
5. затем использовать их для создания вложенных папок в приложении соответствующий каталог 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 в первом листе

ниже код найден файл 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