Question

我在Outlook中使用以下VBA代码将选定的电子邮件复制到系统文件夹。我没有选择电子邮件，而是需要修改代码以复制Outlook中特定文件夹中的所有电子邮件。

' General Declarations
Option Explicit

' Public declarations
' Public Enum olSaveAsTypeEnum
  'olSaveAsTxt = 0
  'olSaveAsRTF = 1
  'olSaveAsMsg = 3
'End Enum

Sub UATExport_MailasMSG()
' Routine will take all selected mails and export them as .MSG files to the
' directory defined by
' Error Handling
On Error Resume Next

' Varaiable Declarations
Dim objItem As Outlook.MailItem
Dim strExportFolder As String: strExportFolder = "I:\Documents\Dscan\"
Dim strExportFileName As String
Dim strExportPath As String
Dim objRegex As Object
Dim OldName As String, NewName As String

' Initiate regex search
Set objRegex = CreateObject("VBScript.RegExp")
With objRegex
.Pattern = "(\s|\\|/|<|>|\|\|\?|:)"
.Global = True
.IgnoreCase = True
End With


' Check if any objects are selected.
If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item has been selected.")
Else
    ' Cycle all selected objects.
    For Each objItem In Application.ActiveExplorer.Selection
        ' If the currently selected item is a mail item we can proceed
        If TypeOf objItem Is Outlook.MailItem Then
            ' Export to the predefined folder.
            strExportFileName = objRegex.Replace(objItem.Subject, "_")
            strExportPath = strExportFolder & strExportFileName & ".txt"
            objItem.SaveAs strExportPath, olSaveAsTxt
            'MsgBox ("Email saved to: " & strExportPath)
            OldName = Dir(strExportPath)
    NewName = Left(strExportPath, Len(strExportPath) - Len(OldName)) & _
              Left(OldName, Len(OldName) - 4) & "DircanReportfor asmsmrwerwdb1u" & _
              CStr(Format(FileDateTime(strExportPath), "ddmmyyhhmmss")) & ".txt"
     Name strExportPath As NewName


' declaration to go with the others
Dim strEmailBodybackup As String

' this will go in your for loop
' Save the body so that we can restore it after.
strEmailBodybackup = objItem.Body

' Edit the body of the mail to suit needs.
objItem.Body = Replace(objItem.Body, "To", "Tscanfile", , 1, vbTextCompare)

' Process the export like in your question

' Restore the body of the original mail
objItem.Body = strEmailBodybackup
        Else
            ' This is not an email item.
        End If
    Next 'objItem
End If

' Clear routine memory
Set objItem = Nothing
Set objRegex = Nothing

End Sub

Answer 1

Folder类提供Items属性，该属性将Items集合对象作为指定文件夹中的Outlook项目集合返回。请注意，Items集合的索引从1开始，并且Items集合对象中的项目不保证按任何特定顺序排列。因此，您可以使用Items集合迭代文件夹中的所有项目。

如果您需要查找与条件相对应的特定项目集，则可以使用Items类的Find / FindNext或Restrict方法。

Sort方法按指定的属性对项目集合进行排序。例如：

Sub SortByDueDate() 
  Dim myNameSpace As Outlook.NameSpace 
  Dim myFolder As Outlook.Folder 
  Dim myItem As Outlook.TaskItem 
  Dim myItems As Outlook.Items  

  Set myNameSpace = Application.GetNamespace("MAPI") 
  Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks) 
  Set myItems = myFolder.Items 
  myItems.Sort "[DueDate]", False 
  For Each myItem In myItems 
    MsgBox myItem.Subject & "-- " & myItem.DueDate 
  Next myItem 
End Sub

将电子邮件从Outlook文件夹复制到系统文件夹

1 个答案: