Excel VBA用户窗体选择要复制的Outlook文件夹 [英] Excel VBA userform to Select Outlook folder to copy from

问题描述

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

I am trying to create a user form that will allow the user to select the folder to copy a set of emails from to an excel spreadsheet. I have done all the rest (ie created the copy process) but currently I have to manually enter the namespace and folder hierarchy for each new installation of this macro. Below is my manual process

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将在很少的人中分享，每个人都有不同的设置。有没有办法，我可以用一个用户表单来设置这个列表框，他们所做的只是选择正确的文件夹，然后点击继续，文件夹选择存储在一个变量或某种类型中。

Now this vba will be shared among a fair few people and each person has a different setup. Is there a way I can set this up in a userform using say a list-box and all they do is select the correct folder and click continue and the folder selection is stored in a variable or some sort?

提前谢谢，

推荐答案

这是你正在尝试的吗？这也将不再需要使用列表框。 ：）

Is this what you are trying? This will also negate the need to use a listbox. :)

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库

And here is via Late Binding i.e, if you do not want to add the reference to Outlook Object x.x Library

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

编辑：

SNAPSHOT

这篇关于Excel VBA用户窗体选择要复制的Outlook文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！