将所有电子邮件和.msg文件保存在Outlook中

jol1234

我一直在使用一段代码将选定的电子邮件另存为.msg文件，但是我不知道要修改什么来保存所有电子邮件：

Option Explicit
Public Sub SaveMessageAsMsg()
  Dim oMail As Outlook.MailItem
  Dim objItem As Object
  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String
  Dim enviro As String
  Dim strFolderpath As String




    enviro = CStr(Environ("USERPROFILE"))
    strFolderpath = BrowseForFolder(enviro & "\documents\")

   For Each objItem In ActiveExplorer.Selection

   If objItem.MessageClass = "IPM.Note" Then
    Set oMail = objItem

  sName = oMail.Subject
  ReplaceCharsForFileName sName, "-"

  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

  sPath = strFolderpath & "\"
  Debug.Print sPath & sName
  oMail.SaveAs sPath & sName, olMSG

  End If
  Next

End Sub

我知道我需要更改ActiveExplorer.Selection中的For Each objItem以包括所有项目，但是我对VB不太熟悉，也没有找到需要替换的项目。

我尝试使用当前文件夹和其他一些选项。

0立方米

例子是

Option Explicit
Public Sub Example()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.Session

    Dim Inbox As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox) ' Inbox

'   // Process Current Folder
    CURRENT_FOLDER Inbox

End Sub

Private Sub CURRENT_FOLDER(ByVal ParentFolder As Outlook.MAPIFolder)
    Dim SUBFOLDER As Outlook.MAPIFolder

    Dim Items As Outlook.Items
    Set Items = ParentFolder.Items
    Debug.Print ParentFolder.Name ' Print on Immediate Window

    Dim i As Long
    For i = Items.Count To 1 Step -1
        DoEvents
        Debug.Print Items(i).Subject ' Print on Immediate Window
    Next

'   // Recurse through subfolders
    If ParentFolder.Folders.Count > 0 Then
        For Each SUBFOLDER In ParentFolder.Folders
            CURRENT_FOLDER SUBFOLDER
        Next
    End If

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。