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

Question

下面的代码应该从Outlook中的文件夹中收集联系人到Excel。

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

当我使用默认的联系人文件夹运行代码时，它可以工作。

[当我尝试使用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

Answer 1

在出错时继续执行下一步，紧接着在出错时转到0。在两者之间争取零行。

设置colContacts = FolderChosen.Items（原始功能可能与GetFolder函数一起使用？）

要确认FolderChosen是联系人文件夹。如果FolderChosen.DefaultItemType = olContactItem

Answer 2

命名空间对象没有GetFolder方法。

有GetFolderFromID，但它采用文件夹条目ID（字符串）和（可选）商店条目ID。

为什么不简单地使用FolderChosen.Items？

作为一般评论，请避免使用“下一步继续出错”。出现错误时，有充分的理由。至少，您将能够看到此错误。在您的情况下，这对您很有帮助：“对象不支持此属性或方法：'Namespace.GetFolder'“