2016-04-23 17 views
0

OutlookでVBAを使用する電子メールから添付ファイルをネットワーク上の特定の場所(Z :)にコピーしようとしています。私はこれのための様々なスクリプトを見てきましたが、私を引き裂くのはファイル構造です。以下のようになります:VBAを使用してOutlookのいくつかのネストされたフォルダから添付ファイルを引き出す

Inbox 
Drafts 
Outbox 
My Folder 
    Employer Name 
    Project Name 
     Organizational Folder 
     Organizational Folder 
    Project Name 
     Organizational Folder 
     Organizational Folder 
    Employer Name 
    Project Name 
     Organizational Folder 
     Organizational Folder 

んが、メールのみが組織フォルダ(これらは、などのジョブ情報、承認、のようなものになります)の内部で、雇用者またはプロジェクトフォルダに保存するつもりはありません。

Outlookとネットワークの両方にこれらのフォルダを自動的に作成する別のスクリプトを作成しましたので、フォルダは常に存在しますが、任意の数のProjectフォルダと同じ数のEmployerフォルダが存在する可能性があります。

だから基本的にOutlookの\My Folder\Employer 1\Project 2\Organizational Folder\からの添付ファイルは私が添付ファイルをコピーするために、各フォルダ構造を掘り下げるために何とか場合はネストされたループを使用する必要がありますと仮定していZ:\Employer 1\Project 2\Organizational Folder\

にコピーする必要があります。

私は基本的なプログラミングのコンセプトにはある程度精通していますが、VBAとマイクロソフトのマクロについてはまったく新しいものなので、誰かが多少のコード​​スニペットや私のためのいくつかの読書は素晴らしいだろう!

+0

この回答を見てください:(http://stackoverflow.com/a/12146315/973283)[VBAやマクロを使用してExcelにOutlookメールメッセージをコピーする方法]。答えのほとんどは、あなたの現在の質問に関連していないVBAのような電子メールを表示することに関係しています。一番下には、階層内の任意の場所でフォルダを検索する再帰ルーチンのペアがあります。 「\ My Folder」の前にPSTファイル名を置く必要があります。 –

+0

前のコメントで参照されている回答は、Outlookオブジェクトモデルに関するOTTチュートリアルを提供する以前の回答にリンクしています。役に立つとわかるかもしれません –

答えて

1

私はあなたが何をしようとしているか把握していますが、これはトリックを行うと思います。注 - フォルダ構造が3レベル以下になる場合にのみ機能し、必要に応じてレベルを追加できます。また、再帰的なサブを使ってフォルダを検索することも考えられます。 これはテストされていないスードコードですが、必要なものの少なくとも90%が必要です。

Sub SaveOutlookAttachments() 

Dim Ol As New Outlook.Application 
Dim Tf As Outlook.Folder, Sf1 As Outlook.Folder, Sf2 As Outlook.Folder, Sf3 As Outlook.Folder 

'Bind Fl to your top folder 
Set Tf = Ol.Session.GetDefaultFolder(olFolderInbox).Folders("My Folder") 
'Loop through each subfolder 
For Each Sf1 In Tf.Folders 
    For Each Sf2 In Sf1.Folders 
     For Each Sf3 In Sf2.Folders 
      'Loop through items in Sf3 
      Call SaveAtt(Sf3, Tf.Name & "\" & Sf1.Name & "\" & Sf2.Name & "\" & Sf3.Name & "\") 
     Next 
     'Loop through items in Sf2 
     Call SaveAtt(Sf2, Tf.Name & "\" & Sf1.Name & "\" & Sf2.Name & "\") 
    Next 
    'Loop through items in Sf1 
    Call SaveAtt(Sf1, Tf.Name & "\" & Sf1.Name & "\") 
Next 

'Quit outlook 
Ol.Quit 
Set Ol = Nothing 

End Sub 

Sub SaveAtt(OlFolder As Outlook.Folder, SaveFolder As String) 

'***Alter this*** 
Const MainFolder = "\\Server\Folder1\Folder2\" 
'**************** 
Dim Mi As Outlook.MailItem 
Dim Att As Outlook.Attachment 
Dim FSO As New FileSystemObject 

'Loop through items within the folder passed to the sub 
For Each Mi In OlFolder.Items 
    'Check for an attachment 
    If Mi.Attachments.Count > 1 Then 
     'Check if the folder exists 
     If FSO.FolderExists(MainFolder & SaveFolder) = False Then FSO.CreateFolder (MainFolder & SaveFolder) 
     'Save the attachments 
     For Each Att In Mi.Attachments 
      Att.SaveAsFile (MainFolder & SaveFolder & Att.Filename) 
     Next 
    End If 
Next 
Set FSO = Nothing 

End Sub 
+0

ブリリアント。私のニーズに合わせて少し変更したが、ちょうどうまくいった!ありがとうございました! –

関連する問題