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 

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ファイルで自分にメッセージを送ったあなたは、あなたのファイルパスを更新する必要があり、そしてあなたは私のテストでは

を開いているファイルから、セル範囲になる関心

のものであってもよいですそして最初のシートでA1で「ボブ」とExcelワークブック

は、以下のコードは、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