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将在少数人之间共享,每个人都有不同的设置.有没有办法我可以用一个列表框在用户表单中设置它,他们所做的只是选择正确的文件夹并单击继续,文件夹选择存储在变量或某种类型中？

先感谢您,

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对象xx库的引用

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

编辑:

快照