Question

我在Excel VBA上遇到了一个问题，其他软件在我的电脑上运行。

我创建了一个excel文件并使用DDE连接交易软件（SPTrader）的数据很好。

现在我想将交易记录检索回excel文件以用于其他目的。

然后我使用WinAPI FindWindow和FindWindowEX在SPTrader的账户部分下找到交易记录字段的窗口。我也可以使用ShowWindow（SW_MAXIMIZE / SW_RESTORE）测试窗口并证明我得到了正确的区域。

在这些区域，软件只允许使用鼠标右键单击，然后从下拉列表中选择“复制所有交易”。不允许Ctrl + C.

但是当我使用SendMessage（CB_GETLBTEXT，CB_SELECTSTRING，LB_GETTEXT，LB_GETITEMDATA，LB_GETTEXTLEN）并指向窗口（通过hwnd）获取记录但它返回0时。

现在我只使用VBA代码将整个软件设置为指定位置并调整窗口大小。然后将鼠标光标调到该位置并右键单击并选择“复制所有交易”，然后粘贴到Excel文件中。

所以，我的问题是：是否可以通过VBA从交易记录区域检索数据？这个区域的类型是什么？表，列表框，记录集......？交易完成后如何在不手动运行函数的情况下检索数据？

非常感谢！

Public Sub TradesOrder()
    Dim mainwnd As String
    Dim mainwnd_ac As String
    Dim hwnd As String
    Dim Chwnd1 As String
    Dim Chwnd2 As String
    Dim Chwnd3 As String
    Dim Chwnd4 As String
    Dim Chwnd5 As String
    Dim Chwnd6 As String
    Dim Chwnd7 As String

    Dim wkb As Workbook
    Dim wb As String
    Dim sht As String
    Dim dirty As Long

    wb = "SPTrader_Excel_KK.xlsm"

    sht = "SPTrader_XLS"

    On Error Resume Next
    Set wkb = Workbooks("SPTrader_Excel_KK.xlsm")

    If wkb Is Nothing Then
        Workbooks.Open (ThisWorkbook.Path & "\" & wb)
        Workbooks(wb).Activate
        Worksheets(sht).Activate
    Else
        Workbooks(wb).Activate
        Worksheets(sht).Activate
    On Error GoTo 0
    End If

    mainwnd = Worksheets(sht).Range("AC1").Value
    mainwnd_ac = Worksheets(sht).Range("AC2").Value

    hwnd = FindWindow(vbNullString, mainwnd)
    Chwnd1 = FindWindowEx(hwnd, 0&, "MDIClient", vbNullString)
    Chwnd2 = FindWindowEx(Chwnd1, 0&, "TfrmAccBox", vbNullString)
    Chwnd3 = FindWindowEx(Chwnd2, 0&, "TPageControl", vbNullString)
    Chwnd4 = FindWindowEx(Chwnd3, 0&, "TTabSheet", "Order")
    Chwnd5 = FindWindowEx(Chwnd4, 0&, "TAdvStringGrid", vbNullString)
    Chwnd6 = FindWindowEx(Chwnd5, 0&, "TAdvRichEdit", vbNullString) 'TAdvRichEdit 'TGridDatePicker

    SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 850, 620, SWP_SHOWWINDOW
    BringWindowToTop Chwnd2
    BringWindowToTop Chwnd4
    ShowWindow Chwnd4, SW_NORMAL
    SetCursorPos 500, 540                           'x and y mouse position
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0   'RightClick
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0     'RightClick
    Sleep 100
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0   'RightClick
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0     'RightClick
    SendKeys "{DOWN}"
    SendKeys "{DOWN}"
    Sleep 100
    SendKeys "{ENTER}"

    Worksheets(sht).Activate
    Worksheets(sht).Range("C25").Select
    Range("C25").PasteSpecial xlPasteAll

End Sub

Answer 1

在Excel VBA上，您可以使用EnumChildWindows函数首先从“SPSytem”的窗口标题中查找SP窗口处理程序，其次还可以从“帐户信息”的标题中找到其当前交易记录的子窗口处理程序，标题为“订单” “和”TAdvStringGrid“的类名。（因为记录区文本不在标题编辑文本中）之后，使用SetForegroundWindow（）和SetCursorPos（）在今天的交易记录下找到复制按钮的区域。使用mouse_event到righ - 单击复制按钮将记录保存到系统剪贴板中。现在可以将其粘贴回任何带有VBA代码的激活Excel工作表。以下附加代码仅供参考。您可以在打开新的xls表后在VBA模块上测试它。最后，记录结果粘贴在Range（“A10：Z100”）

上

将您的SP交易者标题替换为VBA代码版本：str =“SPSystem R8.75.3”。你的是R8.74.2。其他类名和名称应该相同。

提醒：在VBA运行期间，应始终在窗口上显示和查看交易记录区域，并且不要隐藏它。为安全起见，在代码中使用了ShowWindow（）。 VBA代码如下。

   
    Private Declare Function SendMessageSTRING Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Public Declare Function SendDlgItemMessageW Lib "user32" (ByVal hdlg As Long, ByVal nIDDlgItem As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Const WM_GETTEXT = &HD
    Public Const CWP_ALL = 0
    Public Const CWP_SKIPINVISIBLE = 1
    Public Const CWP_SKIPDISABLED = 2
    Public Const CWP_SKIPTRANSPARENT = 3
    Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent _
        As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Public Declare Function GetWindowText Lib "user32" _
       Alias "GetWindowTextA" _
      (ByVal hwnd As Long, _
       ByVal lpString As String, _
       ByVal cch As Long) As Long
    Public Declare Function GetClassName Lib "user32" _
       Alias "GetClassNameA" _
      (ByVal hwnd As Long, _
       ByVal lpClassName As String, _
       ByVal nMaxCount As Long) As Long
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    Private Const BM_CLICK = &HF5
    Private Const BM_SETSTATE = &HF3
    Private Const WM_LBUTTONDOWN = &H201
    Private Const WM_LBUTTONUP = &H202
    Private Const MK_LBUTTON = &H1
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
    Public Const MOUSEEVENTF_LEFTDOWN = &H2
    Public Const MOUSEEVENTF_LEFTUP = &H4
    Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
    Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
    Public Declare Function ShowWindow Lib "user32" _
        (ByVal lHwnd As Long, _
        ByVal lCmdShow As Long) As Boolean
    Declare Function GetCursorPos Lib "user32" (lpPoint As RECT) As Long
    Dim cReturn As Long, lParam As Long, parHwnd As Long
    Dim str As String, fhwnd As Long
    Sub traderecord()
    Range("A10:Z100").ClearContents
    str = "SPSystem R8.75.3"
    cReturn = EnumChildWindows(0, AddressOf EnumChildProc, lParam)
    Debug.Print str
    Debug.Print fhwnd
    str = "Account Info"
    cReturn = EnumChildWindows(fhwnd, AddressOf EnumChildProc, lParam)
    Debug.Print str
    Debug.Print Hex(fhwnd)
    fhwnd2 = fhwnd
    ShowWindow fhwnd2, 3
    str = "Order"
    cReturn = EnumChildWindows(fhwnd, AddressOf EnumChildProc, lParam)
    Debug.Print str
    Debug.Print fhwnd
    Range("A9") = "HWND"
    Range("B9") = Hex(fhwnd)
    str = "TAdvStringGrid"
    cReturn = EnumChildWindows(fhwnd, AddressOf EnumChildProc, lParam)
    Debug.Print str
    Debug.Print Hex(fhwnd)
    Range("A9") = "HWND"
    Range("B9") = Hex(fhwnd)
    ForegroundHwnd2 = SetForegroundWindow(fhwnd)
    Dim rt As RECT
    GetCursorPos rt
    x = rt.Left
    y = rt.Top
    Debug.Print x & "=="
    GetWindowRect fhwnd, rt
    Debug.Print rt.Top
    SetCursorPos rt.Left + 10, rt.Top + 30
    Sleep 200
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
    SetCursorPos rt.Left + 30, rt.Top + 60
    Sleep 200
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
    Sleep 500
    ShowWindow fhwnd2, 1
    'Range("A1").Copy
    'Dim DataObj As MSForms.DataObject
    'Set DataObj = New MSForms.DataObject
    'DataObj.GetFromClipboard
    ' strPaste = DataObj.GetText(1)
    'Debug.Print strPaste
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Activate
    ws.Range("A10").Select
    ws.Paste
    SetCursorPos x, y
    str = "Microsoft Excel"
    cReturn = EnumChildWindows(0, AddressOf EnumChildProc, lParam)
    Debug.Print str
    Debug.Print Hex(fhwnd)
    ForegroundHwnd2 = SetForegroundWindow(fhwnd)
    ws.Range("A10").Select
    End Sub
    Private Function EnumChildProc(ByVal lHwnd As Long, ByVal lParam As Long) As Long
        Dim RetVal As Long
        Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
        Dim WinClass As String, WinTitle As String
        Dim ChildCount As Integer    ' Number of Child Windows
        Dim cLV As Long                 ' Child window handle
        RetVal = GetClassName(lHwnd, WinClassBuf, 255)
        WinClass = StripNulls(WinClassBuf)  ' remove extra Nulls & spaces
        RetVal = GetWindowText(lHwnd, WinTitleBuf, 255)
        WinTitle = StripNulls(WinTitleBuf)
        ChildCount = ChildCount + 1
        If WinClass = "ListView20WndClass" Then    ' ListView Window
           cLV = lHwnd
            EnumChildProc = False
        Else
            EnumChildProc = True
        End If
        If (InStr(WinClass, str) > 0 Or InStr(WinTitle, str) > 0) Then
        Debug.Print ChildCount & " Child Handle: " & Hex(lHwnd); lHwnd; "   Child Class = "; WinClass; ", Title = "; WinTitle
        fhwnd = lHwnd
        EnumChildProc = False
        End If
        End Function
        Private Function StripNulls(OriginalStr As String) As String
        If (InStr(OriginalStr, Chr(0)) > 0) Then
          OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
        End If
        StripNulls = OriginalStr
        End Function

从其他软件

1 个答案: