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 が返されます。オブジェクトはこのプロパティまたはメソッド
をサポートしていません。エラーの強調表示されたコード ブロックは次のとおりです。

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 に答える