2015-10-04 6 views
0

Chaque salarié obtient une liste de contacts mise à jour. Je crée une macro dans Excel qui supprimera tous les contacts Outlook, puis importera tous les contacts de cette feuille dans leurs principaux contacts Outlook. Tous les utilisateurs ne sont pas sur la même version Outlook, donc je ne peux pas utiliser les méthodes Early Binding car la bibliothèque OBJ Outlook ne peut pas être référencée entre les versions.Conversion de VBA de liaison anticipée en VBA de liaison tardive: contacts Excel vers Outlook

J'ai réussi à obtenir ma liaison de suppression en liaison tardive facilement, mais j'ai du mal à obtenir le code d'importation pour travailler en liaison tardive. Voici la méthode rapide de liaison de travail que j'ai actuellement pour l'importation:

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

Exactement quel problème avez-vous? Il serait plus rapide d'afficher votre code en retard pour les commentaires. Je ne vois rien dans votre code lié au début qui vous empêcherait de changer votre 'Dim x As [someOutlookType]' en 'Dim x As Object' –

+0

Quel est le rôle de' strDummy' ici? Vous le déclarez mais ne lui attribuez aucune valeur. –

+0

strDummy est utilisé dans mon instruction For Each dans olConItems pour être utilisé comme espace réservé rapide. Pas la meilleure habitude, mais ça marche pour l'instant. –

Répondre

2

Pour utiliser la liaison tardive, vous devez déclarer tous vos objets spécifiques Outlook comme Object:

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

Ensuite:

Set olApp = CreateObject("Outlook.Application") 

Ceci fera que chaque ordinateur créera l'olApp objet de la bibliothèque Outlook installée sur celui-ci. Cela vous évite de définir une référence explicite à Outlook14 dans le classeur que vous allez distribuer (supprimez cette référence du projet avant de distribuer le fichier Excel).

Hope this helps :)

+0

merci! cela a fonctionné. –

1

Toutes vos déclarations d'objet Outlook devraient d'abord devenir des déclarations d'objet non liées Oulook.

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

Vous aurez besoin d'un CreateObject function sur le Outlook.Application object.

Set olApp = CreateObject("Outlook.Application") 

Tout le reste devrait se mettre en place.

+0

merci! cela marche –