2015-10-04 68 views
0

每位員工都會獲取更新的聯繫人列表。我在Excel中創建了一個宏,它將刪除所有Outlook聯繫人,然後將該表中的所有聯繫人導入他們的主Outlook聯繫人。並非所有用戶都處於相同的Outlook版本,所以我無法使用早期綁定方法,因爲Outlook OBJ庫不能在不同版本之間引用。將早期綁定VBA轉換爲後期綁定VBA:Excel到Outlook聯繫人

我設法讓我的刪除循環很容易地進入後期綁定,但我無法讓導入代碼在後期綁定中工作。這裏是工作的早期綁定的方法我目前有進口:

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 

末次

+0

你到底有什麼困難?發佈你的不太有效的後期代碼來發表評論會更快。我在你的早期代碼中沒有看到任何東西會阻止你將Dim x As [someOutlookType]切換到Dim x As Object# –

+0

'strDummy'在這裏有什麼作用?您聲明它,但不要爲其分配任何值。 –

+0

strDummy用於我在olConItems中的For Each語句以真正用作快速佔位符。不是最好的習慣,但它現在起作用。 –

回答

2

使用後期綁定,您應該聲明你的所有特定的Outlook對象爲Object

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

Then:

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 functionOutlook.Application object

Set olApp = CreateObject("Outlook.Application") 

其他一切都應該落實到位。

+0

謝謝!這工作 –