将早期绑定 VBA 转换为后期绑定 VBA : Excel 到 Outlook 联系人
Convert Early Binding VBA to Late Binding VBA : Excel to Outlook Contacts
每个员工都会得到一个更新的联系人列表。我正在 Excel 中创建一个宏,它将删除所有 outlook 联系人,然后将 sheet 上的所有联系人导入到他们的主要 outlook 联系人中。并非所有用户都使用相同的 Outlook 版本,因此我无法使用早期绑定方法,因为无法在版本之间引用 Outlook OBJ 库。
我设法轻松地使我的删除循环进入后期绑定,但我无法让导入代码在后期绑定中工作。这是我目前用于导入的有效早期绑定方法:
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
结束子
要使用后期绑定,您应该将所有特定于 Outlook 的对象声明为 Object
:
Dim olApp As Object, olNamespace As Object, olFolder As Object, olConItems As Object
然后:
Set olApp = CreateObject("Outlook.Application")
这将使每台计算机从其上安装的 Outlook 库创建 olApp 对象。它避免您在要分发的工作簿中设置对 Outlook14 的显式引用(在分发 Excel 文件之前从项目中删除该引用)。
希望这对您有所帮助:)
您所有的 Outlook 对象声明首先必须成为非 Oulook 相关的对象声明。
Dim olApp As Object
Dim olNamespace As Object
Dim olFolder As Object
Dim olConItems As Object
Dim olItem As Object
你需要 CreateObject function on the Outlook.Application object.
Set olApp = CreateObject("Outlook.Application")
其他一切都应该到位。
每个员工都会得到一个更新的联系人列表。我正在 Excel 中创建一个宏,它将删除所有 outlook 联系人,然后将 sheet 上的所有联系人导入到他们的主要 outlook 联系人中。并非所有用户都使用相同的 Outlook 版本,因此我无法使用早期绑定方法,因为无法在版本之间引用 Outlook OBJ 库。
我设法轻松地使我的删除循环进入后期绑定,但我无法让导入代码在后期绑定中工作。这是我目前用于导入的有效早期绑定方法:
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
结束子
要使用后期绑定,您应该将所有特定于 Outlook 的对象声明为 Object
:
Dim olApp As Object, olNamespace As Object, olFolder As Object, olConItems As Object
然后:
Set olApp = CreateObject("Outlook.Application")
这将使每台计算机从其上安装的 Outlook 库创建 olApp 对象。它避免您在要分发的工作簿中设置对 Outlook14 的显式引用(在分发 Excel 文件之前从项目中删除该引用)。
希望这对您有所帮助:)
您所有的 Outlook 对象声明首先必须成为非 Oulook 相关的对象声明。
Dim olApp As Object
Dim olNamespace As Object
Dim olFolder As Object
Dim olConItems As Object
Dim olItem As Object
你需要 CreateObject function on the Outlook.Application object.
Set olApp = CreateObject("Outlook.Application")
其他一切都应该到位。