要点:
如何在不知道所谓的内容的情况下调用收件箱的 subfolders
?在将它们导出到.pst的情况下,这甚至是可能的吗?
完整说明:
我在Outlook Exchange 2010环境中工作。
我尝试将电子邮件导出到大约30个用户的.pst文件。它们从服务器上的无限存储空间转移到1.5 GB。这尤其令人遗憾,因为由于政策和法律原因,用户必须保留文件。我已采取措施缩小尺寸,但其中一些收件箱非常庞大。
通过研究,我发现了一段代码,可以将与电子邮件帐户关联的所有项目导出到单个.pst,并且我已修改该代码以定位特定的 subfolder
在该帐户内。
接下来,我希望能够在收件箱下定位一系列 subfolders
。我能以某种方式遍历它们 - 没有指定它们的名字吗?这会在这种情况下起作用吗?注意:我有 userform
,允许他们选择要从中导出的帐户。
代码:
Option Explicit
Sub BackUpEmailInPST()
Dim olNS As Outlook.NameSpace
Dim olBackup As Outlook.Folder
Dim bFound As Boolean
Dim strPath As String
Dim strDisplayName As String
strDisplayName = "Backup " & Format(Date, "yyyymmdd")
strPath = "C:\Users\TaylorMat\Documents\Attachments\" & strDisplayName & ".pst"
Set olNS = GetNamespace("MAPI")
olNS.AddStore strPath
Set olBackup = olNS.Folders.GetLast
olBackup.Name = strDisplayName
RunBackup olNS, olBackup
olNS.RemoveStore olBackup
lbl_Exit:
Set olNS = Nothing
Set olBackup = Nothing
Exit Sub
End Sub
Sub RunBackup(olNS As Outlook.NameSpace, olBackup As Outlook.Folder)
Dim oFrm As New frmSelectAccount
Dim strAcc As String
Dim olStore As Store
Dim olFolder As Folder
Dim olNewFolder As Folder
Dim i As Long
With oFrm
.BackColor = RGB(191, 219, 255)
.Height = 190
.Width = 240
.Caption = "Backup E-Mail"
With .CommandButton1
.Caption = "Next"
.Height = 24
.Width = 72
.Top = 126
.Left = 132
End With
With .CommandButton2
.Caption = "Quit"
.Height = 24
.Width = 72
.Top = 126
.Left = 24
End With
With .ListBox1
.Height = 72
.Width = 180
.Left = 24
.Top = 42
For Each olStore In olNS.Stores
If Not olStore.DisplayName = olBackup Then
.AddItem olStore
End If
Next olStore
End With
With .Label1
.BackColor = RGB(191, 219, 255)
.Height = 24
.Left = 24
.Width = 174
.Top = 6
.Font.Size = 10
.Caption = "Select e-mail store to backup"
.TextAlign = fmTextAlignCenter
End With
.Show
If .Tag = 0 Then GoTo lbl_Exit
With oFrm.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
strAcc = .List(i)
Exit For
End If
Next i
End With
Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderInbox)
Set olNewFolder = olFolder.Folders("Export")
olNewFolder.CopyTo olBackup
DoEvents
Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderSentMail)
olFolder.CopyTo olBackup
End With
lbl_Exit:
Unload oFrm
Set olStore = Nothing
Set olFolder = Nothing
Exit Sub
End Sub
答案 0 :(得分:0)
使用MAPIFolder.Folders集合循环遍历子文件夹。
你为什么使用Set olBackup = olNS.Folders.GetLast?系列不保证按任何特定顺序排列。使用文件夹名称(olNS.Folders.Item("Folder name"))