Сохранить вложения электронной почты в сетевое расположение

Question

Я пытаюсь создать макрос VBA, который сохраняет вложение электронной почты в папку в зависимости от адреса электронной почты. Например, если я получаю и отправляю электронное письмо с приложением от joey@me.com, я хочу сохранить это вложение в каталоге \ server \ home \ joey , или если я получу его с steve@me.com, вложение должно быть сохранено в \ 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 

Answer 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 "joey@me.com" 
       SaveAsName = mypath & "joey\" & strSubj & "--" & strdate & ".msg" 
      Case "steve@me.com" 
       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 

Answer 2

Это никогда не будет работать. Поскольку Outlook 2010 не сохраняет файл MSG на сетевой диск, работает только локальный диск! Как описано в документации M $ и проверено мной. Простой тест с фиксированным путем и именем файла. Местный c: \ works. Сетевой диск в UNC или L: не работает !!!!