|
在excel论坛找到一个可以发送微信的列子,希望哪位大神可以改进下
Sub login()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim elementcol As IHTMLElementCollection
Dim element As IHTMLElement
Dim dWinFolder As New ShellWindows
Dim txt As New DataObject
Dim i%, n
'Application.ScreenUpdating = False
On Error Resume Next
'''''打开网页
Set ie = CreateObject("InternetExplorer.Application")
''''''打开微信网页版
ie.Navigate "https://wx2.qq.com/"
'''''显示微信
ie.Visible = True
''' '延迟操作
Application.Wait (Now + TimeValue("0:00:02"))
Do Until ie.ReadyState = 4
DoEvents
Loop
Set doc = ie.document
''''搜索
doc.getElementsByTagName("A")(3).Click
''' '延迟操作
Application.Wait (Now + TimeValue("0:00:01"))
''''清空搜索
doc.getElementsByTagName("INPUT")(0).Focus
n = Sheets(1).[a655536].End(xlUp).Row
For i = 2 To n
''''搜索内容写入搜索框
doc.getElementsByTagName("INPUT")(0).Value = Cells(i, 1).Value
SendKeys "{BS}"
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "~"
Application.Wait (Now + TimeValue("0:00:01"))
txt.SetText Cells(i, 2).Value
txt.PutInClipboard
SendKeys "^v"
SendKeys "~"
Application.Wait (Now + TimeValue("0:00:01"))
doc.getElementsByTagName("A")(3).Click
Application.Wait (Now + TimeValue("0:00:01"))
doc.getElementsByTagName("INPUT")(0).Focus
Next
MsgBox "已运行完毕"
Set element = Nothing
Set elementcol = Nothing
Set doc = Nothing
Set ie = Nothing
'Application.ScreenUpdating = True
End Sub
前提条件:请用IE登录好你的微信网页版 |
|