2015-10-04 32 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

谢谢!这工作 –