2012-04-20 32 views
1

メールアドレスに応じてメール添付ファイルをフォルダに保存するVBAマクロを作成しようとしています。たとえば、[email protected]からの添付ファイルを受信して​​電子メールで送信する場合は、その添付ファイルを \ server \ home \ joey に保存するか、[email protected]から添付ファイルを保存する必要があります \ server \ home \ steve。添付ファイルをネットワーク上の場所に保存する

最後に、保存されたファイルの名前の返信メールを送信します。私が欲しいものをほとんど実行するコードをいくつか見つけましたが、それを修正するのが難しいです。これはすべてOutlook 2010で行われています。これが私がこれまで行ってきたことです。どんな助けがあれば幸いです。

Const mypath = "\\server\Home\joe\" 
Sub save_to_v() 

    Dim objItem As Outlook.MailItem 
    Dim strPrompt As String, strname As String 
    Dim sreplace As String, mychar As Variant, strdate As String 
    Set objItem = Outlook.ActiveExplorer.Selection.item(1) 
    If objItem.Class = olMail Then 

     If objItem.Subject <> vbNullString Then 
      strname = objItem.Subject 
     Else 
      strname = "No_Subject" 
     End If 
     strdate = objItem.ReceivedTime 

     sreplace = "_" 

     For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "|") 

      strname = Replace(strname, mychar, sreplace) 
      strdate = Replace(strdate, mychar, sreplace) 
     Next mychar 

     strPrompt = "Are you sure you want to save the item?" 
     If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then 
      objItem.SaveAs mypath & strname & "--" & strdate & ".msg", olMSG 
     Else 
      MsgBox "You chose not to save." 
     End If 
    End If 
End Sub 

答えて

1

これはあなたの試みですか? (未テスト

Option Explicit 

Const mypath = "\\server\Home\" 

Sub save_to_v() 

    Dim objItem As Outlook.MailItem 
    Dim strPrompt As String, strname As String, strSubj As String, strdate As String 
    Dim SaveAsName As String, sreplace As String 
    Dim mychar As Variant 

    Set objItem = Outlook.ActiveExplorer.Selection.Item(1) 

    If objItem.Class = olMail Then 

     If objItem.Subject <> vbNullString Then 
      strSubj = objItem.Subject 
     Else 
      strSubj = "No_Subject" 
     End If 

     strdate = objItem.ReceivedTime 

     sreplace = "_" 

     For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "|") 
      strSubj = Replace(strSubj, mychar, sreplace) 
      strdate = Replace(strdate, mychar, sreplace) 
     Next mychar 

     strname = objItem.SenderEmailAddress 

     strPrompt = "Are you sure you want to save the item?" 

     If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then 
      Select Case strname 
      Case "[email protected]" 
       SaveAsName = mypath & "joey\" & strSubj & "--" & strdate & ".msg" 
      Case "[email protected]" 
       SaveAsName = mypath & "steve\" & strSubj & "--" & strdate & ".msg" 
      End Select 

      objItem.SaveAs SaveAsName, olMSG 
     Else 
      MsgBox "You chose not to save." 
     End If 
    End If 
End Sub 
+0

ご協力ありがとうございます。 –

0

それは動作しません。 Outlook 2010はmsgファイルをネットワークドライブに保存していないので、ローカルドライブだけが動作しています!! M $のドキュメントに記載されており、私がテストしました。 固定パスとファイル名による簡単なテスト。 ローカルc:\は動作します。 UNCまたはLのネットワークドライブ:動作しません。

関連する問題