[求助]VBA如何操作QQ信息发送－－API

lirong

模擬QQ尾巴發送信息
		
Declare Function FindWindowExA Lib "user32" (ByVal Hwnd1 As Long, ByVal Hwnd2 As Long, _
                 ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function SendMessageA Lib "user32" (ByVal Hwnd As Long, ByVal wMsg As Long, _
                 ByVal wParam As Long, lParam As Any) As Long
Declare Function GetWindowTextA Lib "user32" (ByVal Hwnd As Long, ByVal lpString As String, _
                 ByVal cch As Long) As Long
Const EM_REPLACESEL = &HC2
Const BM_CLICK = &HF5

Sub Test()
  Dim Hwnd  As Long
  Dim Title As String
  Hwnd = FindWindowExA(0, 0, "#32770", vbNullString)
  Do While Hwnd > 0
     Hwnd = FindWindowExA(0&, Hwnd, "#32770", vbNullString)
     Title = Space(255)
     GetWindowTextA Hwnd, Title, 256
     If (Title Like "*聊天中*") Or (Title Like "*群*") Or (Title Like "*會話中*") Then
        SendMsg Hwnd, "QQ消息群發"
     End If
   Loop
End Sub

Function SendMsg(Hwnd As Long, Meg As String)
  Dim Hwnd1 As Long
  Dim Hwnd2 As Long
  Hwnd1 = FindWindowExA(Hwnd, 0, "#32770", vbNullString)
  Hwnd2 = FindWindowExA(Hwnd1, 0, "Button", "發送(S)")
  Hwnd1 = FindWindowExA(Hwnd1, Hwnd2, "AfxWnd42", vbNullString)
  Hwnd1 = FindWindowExA(Hwnd1, 0, "RichEdit", vbNullString)

  SendMessageA Hwnd1, EM_REPLACESEL, 0, ByVal Meg
  SendMessageA Hwnd2, BM_CLICK, 0, ByVal 0
End Function

大均

帮顶一下，希望有高手出现[em04]

t253812748

真的？试试看

a296837698

留下个脚印

418775812

Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Public Sub yvhf()

    Dim i%, a
    a = ThisWorkbook.Worksheets("QQ消息").Range("a" & Cells.Rows.Count).End(3).Row

    For i = 2 To a
        ShellExecute 0, "open", "tencent://message/?uin=" & Range("A" & i) & "&Site=LG&Menu=yes", "", "", 1       //A列中为QQ号
        Application.Wait (Now() + TimeSerial(0, 0, 3))
        SendKeys  Range("B" & i)       //B列为要发送的消息
        SendKeys "+(%s)"
    Next

End Sub

mavin

试过5,6次了，用这种方法群发qq信息或群发qq截图，还是蛮稳定的。有没有高手能够解决怎么发送文件呀？试了一下，在vba中copy文件，再用上述的ctrl+v，不行。