Outlook 2010의 .XLSX 첨부 파일 (VBA 포함)

Question

Outlook 2010을 사용하고 Excel 첨부 파일이 포함 된 전자 메일을 수신합니다. 네트워크 드라이브의 부서 폴더 내에 생성 한 하위 폴더에 첨부 파일을 수동으로 저장합니다.

는 그 다음이 .XLSX 있는지 확인하기 위해 첨부 파일을 확인 그들이 첨부 파일이 있는지 확인하기 위해 수신 이메일을 확인

1. 를 사용하여 코드에 가능하다면 나는 약 궁금 무엇

   ,

2. 그렇다면, 특정 셀의 값을 확인, 첨부 파일을 열
3. 다음 계정 이름 및 문자열로 계좌 번호 다음 가변
4. 앱에 서브 폴더를 생성하기 위해 이들을 사용 보관 ropriate 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 

최종 하위

Answer 1

는 여기에 긴입니다 그것을 할 수있는 하나의 방법입니다 가졌어요. VBA Code to save an attachment (excel file) from an Outlook email that was inside another email as an attachment에서 내 코드는 관심을 가질

당신은 당신의 파일 경로를 업데이트해야합니다, 파일에서 셀 범위 내 테스트에서

을 여는 것을 나는 pdf 파일로 자신에게 메시지를 보내 첫 번째 시트의 A1에서 "밥"과 엑셀 통합 문서는이 아래 디렉토리 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