vba微信群发

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()
If Cells(Selection.row(), Col_Name).Value <> "" Then

　　ID=ToGetID(Cells(Selection.row(), Col_Name).Value)

　　Msg=Cells(Selection.row(), Col_Message).Value
　　Call TxMsg(ID, Msg)
Else
　　MsgBox ("请选择要发送给谁")
End If
End Sub

  

Sub TxMsg(ByVal strWCID As string, strMsg as string)
Set ws = CreateObject("wscript.shell")
ws.AppActivate "微信"
ws.SendKeys "^%w"
Set ws = Nothing
Set ws = CreateObject("wscript.shell")
ws.Run "mshta vbscript:ClipboardData.SetData(" & Chr(34) & "text" & Chr(34) & "," & Chr(34) & strWCID & Chr(34) & ")(close)", 0, True
Sleep 999
ws.SendKeys "^f"
Sleep 999
ws.SendKeys "^v"
Sleep 999
ws.SendKeys "{ENTER}"
Sleep 555
ws.SendKeys "{TAB}"
Sleep 555
ws.Run "mshta vbscript:ClipboardData.SetData(" & Chr(34) & "text" & Chr(34) & "," & Chr(34) & strMsg & Chr(34) & ")(close)", 0, True
Sleep 500
ws.SendKeys "^v"
Sleep 300
ws.SendKeys "{ENTER}"
Set ws = Nothing
End Sub

'强制结束vbs运行
Sub EndVBS()

Set ws = CreateObject("wscript.shell")
ws.Run "taskkill /IM wscript.exe /F"

End Sub