如何在Outlook中选择要导入Excel的文件夹

下面的代码用于从Outlook中的文件夹中获取联系人，并将其保存到Excel中

用户选择的联系人文件夹不是默认的联系人文件夹

当我使用默认的contacts文件夹运行代码时，它会工作

当我尝试使用PickFolder时，它会选择作为变量的文件夹，但不会选择任何联系人

我把**放在了不起作用的地方

Private Sub OutlookImport_Click()

Dim objOutlook 'Outlook object containing contact information
Dim objNamespace 'Interface definition between Excel and Outlook
Dim colContacts 'Collection of contacts in Outlook for harvesting

Dim objExcel As Worksheet 'Worksheet containing extract of Outlook contacts
Dim i As Integer 'Row counter
Dim objContact 'VCard object within Outlook Contacts

'Prompt user to select folder containing contacts for harvesting

Dim OlApp As New Outlook.Application 'Instance of Microsoft Outlook application
Dim NS As Outlook.Namespace
Dim FolderChosen As Outlook.MAPIFolder 'Folder selected by user

Set NS = OlApp.GetNamespace("MAPI")
Set FolderChosen = NS.PickFolder

On Error Resume Next
 Set objOutlook = CreateObject("Outlook.Application")
 Set objNamespace = objOutlook.GetNamespace("MAPI")
 Set objExcel = ActiveWorkbook.Sheets("Outlook Contacts")

 **
 'Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items 'using this line works
 Set colContacts = objNamespace.GetFolder(FolderChosen).Items 'using this line doesn't
 **

 'Set objExcel = CreateObject("Excel.Application")
 'objExcel.Visible = True
 'Set objWorkbook = objExcel.Workbooks.Add()
 'Set objWorksheet = objWorkbook.Worksheets(3)

 'Populate the titles
  objExcel.Cells(1, 1) = "Client Book ID"
  objExcel.Cells(1, 2) = "Contact ID"
  objExcel.Cells(1, 3) = "Title"
  objExcel.Cells(1, 4) = "First Name"
  objExcel.Cells(1, 5) = "Middle Name"
  objExcel.Cells(1, 6) = "Last Name"
  objExcel.Cells(1, 7) = "Suffix"

  objExcel.Cells(1, 8) = "Job Title"
  objExcel.Cells(1, 9) = "Department"
  objExcel.Cells(1, 10) = "CompanyName"

  i = 2

  For Each objContact In colContacts

 ' objExcel.Cells(1, 1) = "Client Book ID"
 'objExcel.Cells(1, 2) = "Contact ID"

  objExcel.Cells(i, 3).Value = objContact.Title
  objExcel.Cells(i, 4).Value = objContact.FirstName
  objExcel.Cells(i, 5).Value = objContact.MiddleName
  objExcel.Cells(i, 6).Value = objContact.LastName
  objExcel.Cells(i, 7).Value = objContact.Suffix

  objExcel.Cells(i, 8).Value = objContact.JobTitle
  objExcel.Cells(i, 9).Value = objContact.Department
  objExcel.Cells(i, 10).Value = objContact.CompanyName

  i = i + 1
  If i > 50 Then Stop - 'just in to make it run quicker

  Next

  End Sub

---

“错误时继续下一步”应尽可能紧跟“错误时转到0”。在两者之间争取零线

Set colContacts=folderselected.Items（原始文件可能使用了GetFolder函数？）

验证FolderSelected是否为contacts文件夹。

---

如果FolderSelected.DefaultItemType=olContactItem，则命名空间对象没有GetFolder方法

有GetFolderFromID，但它接受文件夹条目id（字符串）和（可选）存储条目id

为什么不直接使用FolderSelected.Items呢

---

作为一般性评论，请避免使用“出错后继续下一步”。当出现错误时，有一个很好的理由。至少，您可以看到这是什么错误。在您的情况下，哪一个是非常有用的“对象不支持此属性或方法：'Namespace.GetFolder'”

为什么您认为在随机文件夹中可以找到联系人？我从未在“联系人”文件夹外找到联系人。@Tony Dallimore我将让用户创建联系人，然后将他们的联系人放入一个特殊的“备份文件夹”（文件、新文件夹、联系人），并将备份与公司提供的版本进行比较-我们正在尝试将公司的CRM系统与他们的Outlook联系人连接起来。我不想依赖用户正确地获取文件夹名称-无论我告诉他们什么，一个或多个用户都会将其称为稍有不同的名称…在运行PickFolder方法后，是否检查DefaultItemType以确保所选文件夹是Contacts文件夹？