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

将Outlook邮件保存到由VBA

2 个答案: