Question

我在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应该＆＃34;观看＆＃34;何时添加项目以及保存这些文件的位置。因此，它要求我为每个文件夹编写一个新的Items变量和新的Items_ItemAdd子。

我想做以下事情：

选择应该观看的文件夹＆＃34;对于添加的项目，以及应将其保存到的文件夹，通过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）和一个新的Sub Items（i）_ItemAdd 每次用户选择文件夹和保存文件夹时的VBA代码。但是，我在Outlook中看到这是不可能的，与Excel不同。这是真的？如果没有：如何在Outlook中使用VBA创建VBA代码？
我能想象的另一种方式如下。我将用户输入的内容保存到文本文件中，然后从文本文件中读取并将其保存到数组中。但是，我不知道如何在我的其余代码中使用该数组。我不认为可以使用变量名创建Sub，或者使用＆＃34; ItemAdd＆＃34;运行sub。＆＃39;观察者＆＃39;包含在贯穿数组的for循环中，并根据Array中的索引或类似的东西创建Sub函数。

希望有人能帮助我。或者知道如何让我的想法发挥作用的任何其他想法。

Answer 1

这并没有解决您收集或存储各种文件夹的方式，但展示了如何管理＆＃34;观看＆＃34;的集合。单独的文件夹＆＃34;保存到＆＃34;路径。

首先，创建一个类来管理每个文件夹：

Option Explicit

Private OlFldr As Folder
Private SavePath As String
Public WithEvents Items As Outlook.Items

'called to set up the object
Public Sub Init(f As Folder, sPath As String)
    Set OlFldr = f
    Set Items = f.Items
    SavePath = sPath
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
       'Just a simple message to show what's going on.
       'You can add code here to save the item, or you can pass
       '  arguments to a common sub defined in a regular module
       MsgBox "Mail '" & Item.Subject & "' was added to Folder '" & OlFldr.Name & _
              "' and will be saved to '" & SavePath & "'"
  End If
End Sub

以下是您如何使用该课程设置观看的文件夹：

Option Explicit

Dim colFolders As Collection '<< holds the clsFolder objects

Private Sub SetupFolderWatches()

    'This could be called on application startup, or from the code which collects
    '  user selections for folders/paths

    Dim Ns As Outlook.NameSpace, inboxParent, arrFolders, f, arr
    Set Ns = Application.GetNamespace("MAPI")

    Set colFolders = New Collection
    Set inboxParent = Ns.GetDefaultFolder(olFolderInbox).Parent

    'you'd be reading this info from a file or some other storage...
    arrFolders = Array("Test1|C:\Test1_Files\", "Test2|C:\Test2_Files\")

    For Each f In arrFolders
        arr = Split(f, "|")
        colFolders.Add GetFolderObject(inboxParent.Folders(arr(0)), CStr(arr(1)))
    Next f

End Sub


'"factory" function to create folder objects
Function GetFolderObject(foldr As Folder, sPath As String)
    Dim rv As New clsFolder
    rv.Init foldr, sPath
    Set GetFolderObject = rv
End Function

循环以在选定的Outlook文件夹

1 个答案: