在Excel 2010 VBA宏中显示Outlook GAL [英] Display the Outlook GAL in Excel 2010 VBA Macro

问题描述

您好，我希望能够在Excel中访问Outlook GAL.我正在使用Office 2010(Excel 2010和Outlook 2010).我正在寻找的是能够按一个按钮，然后GAL将显示一个对话框，然后我可以在其中搜索所需的收件人详细信息，然后将其插入到单元格中.在互联网上搜索后，我遇到了适用于Microsoft Word的代码，但是在excel中使用时发生错误.
这里是从这里提供的代码

Hi I am looking to to be able to access the Outlook GAL within Excel. I am using Office 2010 so (excel 2010 and outlook 2010). What i am looking for is to be able to press a button and then the GAL will display a dialog box where i can then search for the recipients details I need and then insert into a cell. Having searched the internet I came across this code which works for Microsoft Word but when used in excel an error occurs.
Here is the code kindly provided from here 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，对象不支持此属性或方法
，并且该错误的突出显示的代码块是

So when running this macro the return error is run time error 438, Object doesn't support this property or method
and the highlighted block of code for the error is

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

任何人都可以提供代码解决方案吗?预先感谢

Can anyone provide a code solution Please? Thanks in advance

推荐答案

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

In order to get that dialog you need to open an instance of Word and then open the dialog inside Word. The code below will return the result to the ActiveCell. It uses late binding, which means it should run in earlier versions of Office as well:

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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！