Excel 2010 VBA 매크로에서 Outlook GAL 표시

Question

안녕하십니까. Excel 내에서 Outlook GAL에 액세스 할 수있게되기를 기대하고 있습니다. 저는 Office 2010을 사용하고 있습니다 (2010 년과 2010 년을 능가합니다). 내가 찾고있는 것은 버튼을 누른 다음 GAL이 필요한 수신자 정보를 검색하고 셀에 삽입 할 수있는 대화 상자를 표시하는 것입니다. 인터넷을 검색하다가 Microsoft Word에서 작동하는이 코드를 발견했지만 Excel에서 사용하면 오류가 발생합니다. 여기
는 반환 오류가 시간 오류 438 실행이 매크로를 실행하는 때, 개체가이 속성 또는 메서드
과에 대한 코드의 강조 블록을 지원하지 않습니다 친절 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 

여기에서 제공되는 코드입니다 오류는

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

누구든지 코드 솔루션을 제공 할 수 있습니까? 미리 감사드립니다.

Answer 1

대화 상자를 표시하려면 Word의 인스턴스를 연 다음 Word에서 대화 상자를 열어야합니다. 아래 코드는 결과를 ActiveCell에 반환합니다. 지금은 내가 끌어 할 1 작은 다른 딜레마를 가지고, 내가 그 완벽에 필요한 그 무엇은 정확히 감사

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