1

您好我希望能够在 Excel 中访问 Outlook GAL。我正在使用 Office 2010（Excel 2010 和 Outlook 2010）。我正在寻找的是能够按下一个按钮，然后 GAL 将显示一个对话框，然后我可以在其中搜索我需要的收件人详细信息，然后插入到一个单元格中。在互联网上搜索后，我发现了适用于 Microsoft Word 的代码，但在 excel 中使用时会出现错误。
这是这里提供的代码http://www.vbaexpress.com/forum/archive/index.php/t-24694.html

Public Sub InsertAddressFromOutlook()   
    Dim strCode As String, strAddress As String
    Dim iDoubleCR As Integer

    'Set up the formatting codes in strCode
    strCode = "<PR_DISPLAY_NAME>" & vbCr & _
    "<PR_POSTAL_ADDRESS>" & vbCr & _
    "<PR_OFFICE_TELEPHONE_NUMBER>" & vbCr

    'Display the 'Select Name' dialog, which lets the user choose
    'a name from their Outlook address book

    strAddress = Application.GetAddress(AddressProperties:=strCode, _
                     UseAutoText:=False, DisplaySelectDialog:=1, _
                     RecentAddressesChoice:=True, UpdateRecentAddresses:=True)

    'If user cancelled out of 'Select Name' dialog, quit
    If strAddress = "" Then Exit Sub

    'Eliminate blank paragraphs by looking for two carriage returns in a row
    iDoubleCR = InStr(strAddress, vbCr & vbCr)
    Do While iDoubleCR <> 0
        strAddress = Left(strAddress, iDoubleCR - 1) & _
                     Mid(strAddress, iDoubleCR + 1)
        iDoubleCR = InStr(strAddress, vbCr & vbCr)
    Loop

    'Strip off final paragraph mark
    strAddress = Left(strAddress, Len(strAddress) - 1)

    'Insert the modified address at the current insertion point
    Selection.Range.Text = strAddress
End Sub


因此，当运行此宏时，返回错误是运行时错误 438，Object 不支持此属性或方法
，并且突出显示的错误代码块是

strAddress = Application.GetAddress(AddressProperties:=strCode, _
    UseAutoText:=False, DisplaySelectDialog:=1, _
    RecentAddressesChoice:=True, UpdateRecentAddresses:=True)

任何人都可以提供代码解决方案吗？提前致谢

4

1 回答 1

1

为了获得该对话框，您需要打开 Word 的一个实例，然后在 Word 中打开该对话框。下面的代码会将结果返回给 ActiveCell。它使用后期绑定，这意味着它也应该在早期版本的 Office 中运行：

Sub GetEmail()

Dim objWordApp As Object
Dim strCode As String
Dim strAddress As String
Dim lngDoubleCR As Long
'Set up the formatting codes in strCode
strCode = "<PR_DISPLAY_NAME>" & vbNewLine & _
          "<PR_POSTAL_ADDRESS>" & vbNewLine & _
          "<PR_OFFICE_TELEPHONE_NUMBER>"

' As GetAddress is not available in MS Excel, a call to MS Word object
' has been made to borrow MS Word's functionality
Application.DisplayAlerts = False
'On Error Resume Next
' Set objWordApp = New Word.Application
Set objWordApp = CreateObject("Word.Application")
strAddress = objWordApp.GetAddress(, strCode, False, 1, , , True, True)
objWordApp.Quit
Set objWordApp = Nothing
On Error GoTo 0
Application.DisplayAlerts = True

' Nothing was selected
If strAddress = "" Then Exit Sub

strAddress = Left(strAddress, Len(strAddress) - 1)

    'Eliminate blank paragraphs by looking for two carriage returns in a row
    lngDoubleCR = InStr(strAddress, vbNewLine & vbNewLine)
    Do While lngDoubleCR <> 0
        strAddress = Left(strAddress, lngDoubleCR - 1) & _
                     Mid(strAddress, lngDoubleCR + 1)
        lngDoubleCR = InStr(strAddress, vbNewLine & vbNewLine)
    Loop
ActiveCell.Value = strAddress
End Sub
于 2012-09-23T15:49:17.203 回答