VBAでローカルドライブに作成されたフォルダにOutlookメッセージを保存する

Question

VBAでフォルダを作成します。

Sub ExtractEmail() 

    Dim OlApp As Outlook.Application 
    Set OlApp = New Outlook.Application 
    Dim Mailobject As Object 
    Dim Email As String 
    Dim NS As NameSpace 
    Dim Folder As MAPIFolder 
    Set OlApp = CreateObject("Outlook.Application") 

    Dim fso As Object 
    Dim fldrname As String 
    Dim fldrpath As String 

    ' Setup Namespace 
     Set NS = ThisOutlookSession.Session 
    ' Display select folder dialog 
     Set Folder = NS.PickFolder 
    ' Create Folder File 
     Set fso = CreateObject("Scripting.FileSystemObject") 

    ' loop to read email address from mail items. 
    For Each Mailobject In Folder.Items 
    fldrname = Mailobject.To 
    fldrpath = "\\abc\" & fldrname 
    If Not fso.folderexists(fldrpath) Then 
     fso.createfolder (fldrpath) 
    End If 

    Set objCopy = Mailobject.Copy 
    objCopy.SaveAs fldrpath, olMSG 

    Next 
    Set OlApp = Nothing 
    Set Mailobject = Nothing 

End Sub 

私はフォルダにメールを保存するために

Mailobject.SaveAs fldrpath, olMSG 

を使用しようとすると、私はファイルに書き込むことはできません。

フォルダを右クリックし、ショートカットメニューのプロパティをクリックしてフォルダのアクセス許可を確認すると、属性は読み取り専用になります。

代替案を教えてもらえますか？

Answer 1

SaveAsに完全修飾ファイル名を渡す必要があります。

objCopy.SaveAs fldrpath & "\test.msg", olMSG 

Answer 2

fldrpath = "\\abc\" & fldrname & 
"\" 
savepath = fldrpath & Mailobject.Subject & Format(Now(), "yyyy-mm-dd- 
hhNNss") 
savepath = savepath & ".msg" 

If Not fso.folderexists(fldrpath) Then 
fso.createfolder (fldrpath) 
End If 


Set objCopy = Mailobject.Copy 
objCopy.SaveAs savepath, olMSG