Excel VBA用户表单选择要从中复制的Outlook文件夹

Question

我正在尝试创建一个用户表单，允许用户选择要将一组电子邮件复制到Excel电子表格的文件夹。我已经完成了所有其余的工作（即创建了复制过程），但是目前我必须为此宏的每个新安装手动输入命名空间和文件夹层次结构。以下是我的手动流程

Set ol_App = New Outlook.Application
Set ol_Namespace = ol_App.GetNamespace("MAPI")
' Set ol_Folder = olNamespace.GetDefaultFolder(olFolderInbox)

' reference the folder that the emails are stored in
Set ol_Folder = ol_Namespace.Folders("Their own namespace")
Set ol_Folder = ol_Folder.Folders("Inbox")
Set ol_Folder = ol_Folder.Folders("Required_Folder")

现在这个vba将在少数人之间分享，每个人都有不同的设置。有没有办法可以使用say-list框在用户窗体中进行设置，他们所做的就是选择正确的文件夹并单击继续，文件夹选择存储在变量或某种类型中？

提前谢谢你，

Answer 1

这是你在尝试什么？这也将无需使用列表框。 ：）

Option Explicit

'~~> Set a reference to Outlook Object x.x Library
Sub Sample()
    Dim oOlApp As Outlook.Application
    Dim objNmSpc As Namespace
    Dim ofldr As Object

    Set oOlApp = Outlook.Application
    Set objNmSpc = oOlApp.GetNamespace("MAPI")
    Set ofldr = objNmSpc.PickFolder

    If Not ofldr Is Nothing Then MsgBox ofldr
End Sub

这是通过Late Binding，即如果你不想添加对Outlook对象x.x库的引用

Option Explicit

Sub Sample()
    Dim oOlApp As Object, objNmSpc As Object, ofldr As Object

    '~~> Establish an Outlook application object
    On Error Resume Next
    Set oOlApp = GetObject(, "Outlook.Application")

    If Err.Number <> 0 Then
        Set oOlApp = CreateObject("Outlook.Application")
    End If
    Err.Clear
    On Error GoTo 0

    Set objNmSpc = oOlApp.GetNamespace("MAPI")
    Set ofldr = objNmSpc.PickFolder

    If Not ofldr Is Nothing Then MsgBox ofldr
End Sub

修改：

<强>快照

Answer 2

您要做的是遍历Outlook文件夹并让每个文件夹名称填充表单的activate事件中的列表框/组合框。通过这样做，当每个人运行它时，他们自己的Outlook配置将是使用的。

这个链接应该是一个良好的开端Outlook Folder Loop