2015-10-04 2 views
0

Каждый сотрудник получает обновленный список контактов. Я создаю макрос в Excel, который удалит все контакты Outlook, а затем импортирует все контакты на этом листе в свои основные контакты Outlook. Не все пользователи имеют одинаковую версию Outlook, поэтому я не могу использовать методы ранней привязки, поскольку в базе данных Outlook OBJ Library нельзя ссылаться между версиями.Преобразование ранних привязок VBA к позднему связыванию VBA: Excel в Outlook Контакты

Мне удалось легко удалить цикл delete в конце привязки, но у меня возникли проблемы с получением кода импорта для работы в позднем связывании. Здесь работает раннее связывание метод, который я в настоящее время для импорта:

Dim olApp As Outlook.Application 
Dim olNamespace As Outlook.Namespace 
Dim olFolder As Outlook.MAPIFolder 
Dim olConItems As Outlook.Items 
Dim olItem As Object 

'Excel objects. 
Dim wbBook As Workbook 
Dim wsSheet As Worksheet 

'Location in the imported contact list. 
Dim lnContactCount As Long 

Dim strDummy As String 

'Turn off screen updating. 
Application.ScreenUpdating = False 

'Initialize the Excel objects. 
Set wbBook = ThisWorkbook 
Set wsSheet = wbBook.Worksheets(1) 

'Format the target worksheet. 
With wsSheet 
    .Range("A1").CurrentRegion.Clear 
    .Cells(1, 1).Value = "Company/Private Person" 
    .Cells(1, 2).Value = "Street Address" 
    .Cells(1, 3).Value = "Postal Code" 
    .Cells(1, 4).Value = "City" 
    .Cells(1, 5).Value = "Contact Person" 
    .Cells(1, 6).Value = "E-mail" 
    With .Range("A1:F1") 
     .Font.Bold = True 
     .Font.ColorIndex = 10 
     .Font.Size = 11 
    End With 
End With 

wsSheet.Activate 

'Initalize the Outlook variables with the MAPI namespace and the default Outlook folder of the current user. 
Set olApp = New Outlook.Application 
Set olNamespace = olApp.GetNamespace("MAPI") 
Set olFolder = olNamespace.GetDefaultFolder(10) 
Set olConItems = olFolder.Items 

'Row number to place the new information on; starts at 2 to avoid overwriting the header 
lnContactCount = 2 

'For each contact: if it is a business contact, write out the business info in the Excel worksheet; 
'otherwise, write out the personal info. 
For Each olItem In olConItems 
    If TypeName(olItem) = "ContactItem" Then 
     With olItem 
      If InStr(olItem.CompanyName, strDummy) > 0 Then 
       Cells(lnContactCount, 1).Value = .CompanyName 
       Cells(lnContactCount, 2).Value = .BusinessAddressStreet 
       Cells(lnContactCount, 3).Value = .BusinessAddressPostalCode 
       Cells(lnContactCount, 4).Value = .BusinessAddressCity 
       Cells(lnContactCount, 5).Value = .FullName 
       Cells(lnContactCount, 6).Value = .Email1Address 
      Else 
       Cells(lnContactCount, 1) = .FullName 
       Cells(lnContactCount, 2) = .HomeAddressStreet 
       Cells(lnContactCount, 3) = .HomeAddressPostalCode 
       Cells(lnContactCount, 4) = .HomeAddressCity 
       Cells(lnContactCount, 5) = .FullName 
       Cells(lnContactCount, 6) = .Email1Address 
      End If 
      wsSheet.Hyperlinks.Add Anchor:=Cells(lnContactCount, 6), _ 
            Address:="mailto:" & Cells(lnContactCount, 6).Value, _ 
            TextToDisplay:=Cells(lnContactCount, 6).Value 
     End With 
     lnContactCount = lnContactCount + 1 
    End If 
Next olItem 

'Null out the variables. 
Set olItem = Nothing 
Set olConItems = Nothing 
Set olFolder = Nothing 
Set olNamespace = Nothing 
Set olApp = Nothing 

'Sort the rows alphabetically using the CompanyName or FullName as appropriate, and then autofit. 
With wsSheet 
    .Range("A2", Cells(2, 6).End(xlDown)).Sort key1:=Range("A2"), order1:=xlAscending 
    .Range("A:F").EntireColumn.AutoFit 
End With 

'Turn screen updating back on. 
Application.ScreenUpdating = True 

MsgBox "The list has successfully been created!", vbInformation 

End Sub

+0

Какая у вас проблема? Было бы быстрее опубликовать ваш незадействованный поздний код для комментариев. Я не вижу ничего в вашем раннем коде, который помешал бы вам просто отключить ваш «Dim x As [someOutlookType]» до «Dim x As Object» –

+0

. Какова роль 'strDummy' здесь? Вы объявляете это, но не присваиваете ему никакой ценности. –

+0

strDummy используется в my For Каждое утверждение в olConItems действительно используется в качестве быстрого заполнителя. Не самая лучшая привычка, но сейчас это работает. –

ответ

2

Для использования позднего связывания, вы должны объявить все ваши Outlook, специфические объекты, как Object:

Dim olApp As Object, olNamespace As Object, olFolder As Object, olConItems As Object 

Тогда:

Set olApp = CreateObject("Outlook.Application") 

Это позволит сделать каждый компьютер создать olApp объект из библиотеки Outlook, которая установлена ​​на нем. Это позволяет вам установить явную ссылку на Outlook14 в книге, которую вы будете распространять (удалите эту ссылку из проекта перед распространением файла Excel).

Надеется, что это помогает :)

+0

спасибо! это сработало. –

1

Всех ваших объявлений объектов Outlook, должно сначала стать не связанными с Oulook декларациями объектов.

Dim olApp As Object 
Dim olNamespace As Object 
Dim olFolder As Object 
Dim olConItems As Object 
Dim olItem As Object 

Вам потребуется CreateObject function на Outlook.Application object.

Set olApp = CreateObject("Outlook.Application") 

Все остальное должно встать на свои места.

+0

спасибо! это работает –