Excel VBA用户窗体select要从中复制的Outlook文件夹

我正在尝试创build一个用户表单，允许用户select文件夹以将一组电子邮件复制到Excel电子表格。 我已经完成了所有其余的（即创build复制过程），但目前我必须手动input名称空间和文件夹层次结构为每个新的macros安装。 以下是我的手动过程

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会被一些公平的人分享，每个人都有不同的设置。 有没有一种方法，我可以设置在一个用户表单中使用一个列表框，他们所做的是select正确的文件夹，然后单击继续和文件夹select存储在一个variables或某种？

先谢谢你，

Answer 1

这是你正在尝试？ 这也将否定使用列表框的必要性。 🙂

 Option Explicit '~~> Set a reference to Outlook Object xx 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 

这里是通过后期绑定即，如果你不想添加对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 

编辑 ：

快照

Answer 2

你想要做的是通过Outlook文件夹循环，并让每个文件夹名称填充窗体的激活事件中的列表框/combobox。 通过这样做，每个人运行它，他们自己的Outlookconfiguration将被使用。

这个链接应该给Outlook文件夹循环一个很好的开始