Question

您好我希望能够在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，对象不支持此属性或方法
，突出显示的错误代码块

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

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

Answer 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

在Excel 2010 VBA宏中显示Outlook GAL

1 个答案: