Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
435 views
in Technique[技术] by (71.8m points)

Convert Early Binding VBA to Late Binding VBA : Excel to Outlook Contacts

Each employee gets an updated contact list. I'm creating a macro in Excel that will delete all outlook contacts, then import all the contacts on that sheet into their main outlook contacts. Not all users are on the same outlook version, so I can't use Early Binding methods since the Outlook OBJ Library cannot be referenced between versions.

I managed to get my delete loop into late binding easily, but I'm having trouble getting the import code to work in late binding. Here is the working early binding method I currently have for the import:

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

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

To use Late binding, you should declare all your Outlook-specific objects as Object:

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

Then:

Set olApp = CreateObject("Outlook.Application")

This will make each computer create the olApp object from the Outlook library that is installed on it. It avoids you to set an explicit reference to Outlook14 in the workbook that you will distribute (remove that reference from the project before distributing the Excel file).

Hope this helps :)


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...