我正在 Outlook 中的 VBA 中执行以下操作。将 Outlook 项目拖到指定文件夹后，我将此 Outlook 项目保存到我的计算机（即文件系统）。
Private WithEvents Items As Outlook.Items
Private WithEvents Items2 As Outlook.Items
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
Set Items = Ns.GetDefaultFolder(olFolderInbox).Parent.Folders("Hello").Items
Set Items2 = Ns.GetDefaultFolder(olFolderInbox).Parent.Folders("Bye").Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
sName = Item.Subject
ReplaceCharsForFileName sName, "_"
dtDate = Item.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, " - hhnn ", _
vbUseSystemDayOfWeek, vbUseSystem) & "- " & sName & ".msg"
sPath = "Y:\BM_Clientenmap\D\Hello\emails\"
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG
End If
End Sub
Private Sub Items2_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
sName = Item.Subject
ReplaceCharsForFileName sName, "_"
dtDate = Item.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, " - hhnn ", _
vbUseSystemDayOfWeek, vbUseSystem) & "- " & sName & ".msg"
sPath = "Y:\BM_Clientenmap\D\Bye\emails\"
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG
End If
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
如果用户将文件添加到顶部声明的变量 Items/Items2 中指定的目录，则此代码会将 Outlook 项目保存到计算机的目录 sPath (Sub Items/Items2_AddItem) 中。
问题是它需要我在 VBA 中手动添加添加项目时 VBA 应“监视”哪些文件夹，以及保存这些文件的位置。因此，它要求我为我拥有的每个文件夹编写一个新的 Items 变量和新的 Items_ItemAdd 子项。
我想做以下事情：
- 通过 Outlook 中的用户界面而不是 VBA 选择应“监视”添加项目的文件夹以及应将其保存到的文件夹。用户应该选择多个文件夹（我不在乎他们是否必须一次选择一个），并且计算机上有多个保存文件夹。
- 我希望 Outlook 记住用户在关闭 Outlook 时所做的选择。
为了使其更加用户友好，我考虑了以下内容。
-
用户在 Outlook 中选择文件夹。我发现执行此操作的代码：
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myOlApp = Outlook.Application
Set iNameSpace = myOlApp.GetNamespace("MAPI")
Set ChosenFolder = iNameSpace.PickFolder
If ChosenFolder Is Nothing Then
GoTo ExitSub:
End If
-
然后，用户选择该项目应保存到计算机上的文件夹。我发现的代码允许您将变量设置为输入文件路径：
Function BrowseForFolder(StrSavePath As String, Optional OpenAt As String) As String
Dim objShell As Object
Dim objFolder ' As Folder
Dim enviro
enviro = CStr(Environ("USERPROFILE"))
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please choose a folder", 0,
enviro & "\Computer\")
StrSavePath = objFolder.self.Path
On Error Resume Next
On Error GoTo 0
ExitFunction:
Set objShell = Nothing
End Sub
我希望当用户按下功能区中要设置宏的按钮时运行上述代码。
我希望 Outlook 监视用户选择的这些文件夹（即 Sub Items_ItemAdd 的作用）。这就是我陷入困境的地方。我希望在 Outlook 关闭后记住用户的选择（即用户不必每次打开 Outlook 时都选择其文件夹）。
现在我的问题如下：
我想象完成这项工作的一种方法是创建一个新变量Items(i)和一个新的子项目(i)_ItemAdd每次用户选择文件夹和保存文件夹时直接在VBA代码中。然而，我读到这在 Outlook 中是不可能做到的，与 Excel 不同。这是真的？如果不是：如何在 Outlook 中使用 VBA 创建 VBA 代码？
我可以想象的另一种方式如下。我将用户输入的内容保存到文本文件中，然后从文本文件中读取并将其保存到数组中。但是，我不知道如何在代码的其余部分中使用该数组。我认为不可能创建具有变量名称的 Sub，或者运行包含在 for 循环中的“ItemAdd”“watcher”的子，该循环遍历数组并根据数组中的索引或其他内容创建 Sub 函数像那样。
希望任何人都可以帮助我。或者知道如何使我的想法发挥作用的任何其他想法。
