Где моя ошибка?VBA - Как выбрать папку в Outlook для импорта в Excel - PullRequest
Новая
       26

Где моя ошибка?VBA - Как выбрать папку в Outlook для импорта в Excel

1 голос
/ 16 марта 2012

Код ниже предназначен для сбора контактов из папки в Outlook в Excel.Пользователь может выбрать папку, потому что я хочу, чтобы он выбрал папку, которая не является папкой контактов по умолчанию.

Когда я запускаю код, используя папку контактов по умолчанию, он работает.Тем не менее, когда я пытаюсь использовать PickFolder, кажется, что он выбирает папку, выбранную в качестве переменной, но не выбирает никаких контактов .... Я положил ** / Emboldened, где он не работает ....

Любая помощь будет принята с благодарностью.

Спасибо

Кристофер 

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

Ответы [ 2 ]

0 голосов
/ 26 октября 2013

Объект пространства имен не имеет метода GetFolder.

Существует GetFolderFromID, но он принимает идентификатор записи папки (строка) и (необязательно) идентификатор записи магазина.

Почему бы просто не использовать FolderChosen.Items?

В качестве общего комментария избегайте использования «On Error Resume Next». Когда возникает ошибка, для этого есть веская причина. По крайней мере, вы сможете увидеть, что это за ошибка. Что в вашем случае очень полезно: «Объект не поддерживает это свойство или метод:« Namespace.GetFolder »»

0 голосов
/ 26 октября 2013

При ошибке Resume Next следует как можно более точно следуя On Error GoTo 0. Стремитесь к нулю строк между двумя.

Установите colContacts = FolderChosen.Items (оригинал мог работать с функцией GetFolder?)

Для проверки FolderChosen является папкой контактов.If FolderChosen.DefaultItemType = olContactItem

...