2012-04-20 56 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

這是你在想什麼? (UNTESTED

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

這個作品感謝您的幫助。 – 2012-04-23 09:56:00

0

它永遠不會工作。由於Outlook 2010沒有將任何msg文件保存到網絡驅動器,只有本地驅動器正在工作!如M $文檔中所述,並由我進行測試。 使用固定路徑和文件名進行簡單測試。 本地c:\ works。 UNC或L中的網絡驅動器不起作用!

相關問題