大家一直对获取QQ聊天记录很感兴趣，今天我就来讲一讲使用微软专门针对盲人做的IAccessible接口来讲讲。

1.使用IAccessible接口.使用以下模块

Option Explicit
'=======================================================================================================
'//功能:枚举值
'//lHwnd=句柄
'//sFindName=查找的元素名称
'//lRole=规则
'Private Sub Command1_Click()
'    Call GetElement(&H9802B2, "", ROLE_TEXT)
'End Sub
'=======================================================================================================

Public Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
                                                            ByVal hwnd As Long, _
                                                            ByVal dwId As Long, _
                                                            riid As tGUID, _
                                                            ppvObject As Object) As Long
Public Declare Function AccessibleChildren Lib "oleacc" ( _
                                                            ByVal paccContainer As IAccessible, _
                                                            ByVal iChildStart As Long, _
                                                            ByVal cChildren As Long, _
                                                            rgvarChildren As Variant, _
                                                            pcObtained As Long) As Long

Type tGUID
      lData1            As Long
      nData2            As Integer
      nData3            As Integer
      abytData4(0 To 7) As Byte
End Type

Private Const S_OK = &H0
Public Const ROLE_TEXT = &H2A&              '文本
Public Const ROLE_COMBOBOX = &H2E&          '下拉列表框
Public Const ROLE_MENUITEM = &HC&  '菜单信息
Public Const ROLE_PUSHBUTTON = &H2B& '按钮
Public Const ROLE_APPLICATION = &HE&        '应用程序
'//枚举值
Public Function GetElement(ByVal lHwnd As Long, ByVal sFindName As String, ByVal lRole As Long) As String
        Dim Ob   As IAccessible
        Set Ob = getFormObject(lHwnd)
        If Ob Is Nothing Then
                Exit Function
        End If
        GetElement = getObjectValue(Ob, sFindName, lRole, 0)
End Function
'//根据句柄获取对象IAccessible接口
Public Function getFormObject(ByVal lHandle As Long) As IAccessible
        On Error Resume Next
        Dim i As Integer
        Dim oIA     As IAccessible
        Dim tg      As tGUID
        Dim lReturn As Long
        With tg
                .lData1 = &H618736E0
                .nData2 = &H3C3D
                .nData3 = &H11CF
                .abytData4(0) = &H81
                .abytData4(1) = &HC
                .abytData4(2) = &H0
                .abytData4(3) = &HAA
                .abytData4(4) = &H0
                .abytData4(5) = &H38
                .abytData4(6) = &H9B
                .abytData4(7) = &H71
        End With
        lReturn = AccessibleObjectFromWindow(lHandle, 0, tg, oIA)
        If lReturn <> S_OK Then Exit Function
        Set getFormObject = oIA
        Set oIA = Nothing
End Function

Public Function getObjectValue(ByVal oIA As IAccessible, ByVal sName As String, ByVal lRole As Long, ByVal lLevel As Long) As String
        Dim oNewIA       As IAccessible
        Dim lStart      As Long
        Dim lHowMany    As Long
        Dim avKids()    As Variant
        Dim lGotHowMany As Long
        Dim lReturn     As Long
        Dim lCurRole    As Long
        Dim sCurName    As String
        Dim i           As Integer
        On Error Resume Next
        lStart = 0
        lHowMany = oIA.accChildCount
        ReDim avKids(lHowMany - 1) As Variant
        lGotHowMany = 0
     
        lReturn = AccessibleChildren(oIA, lStart, lHowMany, avKids(0), lGotHowMany)
        On Error Resume Next

For i = 0 To lGotHowMany - 1
                If IsObject(avKids(i)) = True Then
                        Err.Clear
                        sCurName = avKids(i).accName
                        lCurRole = CLng(avKids(i).accRole)
                        getObjectValue = avKids(i).accValue
                        If InStr(sCurName, " : ") <> 0 Then
                          ‘在此处判断 获取的内容信息。
                        Exit For
                        End If
                       
                        End If
                       
                        If avKids(i).accChildCount > 0 Then
                                Set oNewIA = avKids(i)
                                getObjectValue = getObjectValue(oNewIA, sName, lRole, lLevel + 1)
                        End If
                Else
                        Err.Clear
                        sCurName = oIA.accName(avKids(i))
                        lCurRole = oIA.accRole(avKids(i))
                        getObjectValue = oIA.accValue(avKids(i))
                                If InStr(sCurName, " : ") <> 0 Then
                          ‘在此处判断 获取的内容信息。
                        Exit For
                        End If
                        End If
                       
                End If
        Next i
        Set oNewIA = Nothing
        Erase avKids()
End Function