vb实现网页自动填表

选中复选框

Private Sub Command1_Click() Dim objDoc As Object Dim i As Integer Set objDoc = WebBrowser1.Document.All.tags("button") For i = 0 To objDoc.length - 1 Select Case objDoc(i).Type Case "submit" objDoc(i).Click Exit For End Select Next End Sub

http://www.vbgood.com/viewthread.php?tid=79822

http://wenwen.soso.com/z/q136444728.htm

VB 选定LIST 自动填表

'例子在这..写在command里看<a href="https://www.jb51.cc/tag/xiaoguo/" target="_blank" class="keywords">效果</a>吧..加一个WebBrowser1.之后写上这些<a href="https://www.jb51.cc/tag/xiaoguo/" target="_blank" class="keywords">效果</a> 。。 WebBrowser1.Navigate "http://newreg.qq.com/" Do Until WebBrowser1.ReadyState = READYSTATE_COMPLETE '等装载完 DoEvents Loop WebBrowser1.Document.All.tags("select")(3).selectedIndex = 2 '改<a href="https://www.jb51.cc/tag/shuxing/" target="_blank" class="keywords">属性</a> WebBrowser1.Document.All.tags("select")(3).onchange '确认

直接运行网页中的JavaScript：

function alllefttab()

WebBrowser1.Document.parentwindow.execScript "insert(2)","JavaScript"

自动选择下拉列表中的某项2

Dim s s = "javascript:document.getElementsByName(""w_type"")[0].value='2';void(0)" WebBrowser1.Document.parentwindow.execscript s

添加一个WebBrowser1

Option Explicit Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) Dim SendLog% Private Sub Command1_Click() Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> WebBrowser1.LocationName & "|" & WebBrowser1.LocationURL End Sub Private Sub Form_Load() If App.PrevInstance = True Then Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "你已经运行过一个喽！" End End If Me.Hide WebBrowser1.Left = 240 WebBrowser1.top = 240 WebBrowser1.Navigate "http://zhidao.baidu.com/" 'WebBrowser1.Navigate "http://zhidao.baidu.com/index.<a href="https://www.jb51.cc/tag/PHP/" target="_blank" class="keywords">PHP</a>?act=worklog:loginfo&id=" End Sub Private Sub Form_Resize() WebBrowser1.Width = Me.Width - WebBrowser1.Left - 350 WebBrowser1.Height = Me.Height - WebBrowser1.top - 750 End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object,URL As Variant) Me.Caption = WebBrowser1.LocationName '<a href="https://www.jb51.cc/tag/denglu/" target="_blank" class="keywords">登录</a>并转到 Dim vDoc,vTag Dim i As Integer Dim s If WebBrowser1.LocationURL = "http://zhidao.baidu.com/" Then Set vDoc = WebBrowser1.Document For i = 0 To vDoc.All.length - 1 If UCase(vDoc.All(i).tagName) = "INPUT" Then Set vTag = vDoc.All(i) If vTag.Type = "text" Or vTag.Type = "password" Then Select Case vTag.Name Case "userid" vTag.Value = "wangquan" Case "userps" vTag.Value = "1282" End Select ElseIf vTag.Type = "submit" Then vTag.Click End If End If Next i WebBrowser1.Navigate "http://zhidao.baidu.com/index.<a href="https://www.jb51.cc/tag/PHP/" target="_blank" class="keywords">PHP</a>?act=worklog:insert" End If '是否周末 If WebBrowser1.LocationURL = "http://zhidao.baidu.com/index.<a href="https://www.jb51.cc/tag/PHP/" target="_blank" class="keywords">PHP</a>?act=worklog:insert" Then Set vDoc = WebBrowser1.Document For i = 0 To vDoc.All.length - 1 If UCase(vDoc.All(i).tagName) = "INPUT" Then Set vTag = vDoc.All(i) If vTag.Type = "text" Or vTag.Type = "hidden" Then '填写<a href="https://www.jb51.cc/tag/biaoti/" target="_blank" class="keywords">标题</a> If vTag.Name = "w_title" Then Dim todays todays = IIf(DateDiff("s","07:00:00",Time) < 0,Date - 1,Date) todays = Format(todays,"yyyy年mm月dd日") vTag.Value = todays End If '选择类别 s = "javascript:document.getElementsByName(""w_type"")[0].value='" & IIf(Weekday(Now,2) > 5,1,0) & "';void(0)" WebBrowser1.Document.parentwindow.execScript s End If '提交日志 If SendLog = 0 Then WebBrowser1.Document.parentwindow.execScript "insert(2)","JavaScript" SendLog = 1 End If End If Next i Exit Sub End If '提交<a href="https://www.jb51.cc/tag/tiaozhuan/" target="_blank" class="keywords">跳转</a>http://zhidao.baidu.com/index.<a href="https://www.jb51.cc/tag/PHP/" target="_blank" class="keywords">PHP</a>?act=worklog:insert:sc If WebBrowser1.LocationURL = "http://zhidao.baidu.com/index.<a href="https://www.jb51.cc/tag/PHP/" target="_blank" class="keywords">PHP</a>?act=worklog:insert:sc" Then WebBrowser1.Navigate "http://zhidao.baidu.com/?act=worklog:mylogList" 'Msg<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a> "今天的日志已经提交，但不保证成功哦！",64,Me.Caption End If If WebBrowser1.LocationURL = "http://zhidao.baidu.com/?act=worklog:mylogList" Then Me.Show End If End Sub

http://tieba.baidu.com/f?kz=628000186

'烟花飘飘-{百}度<a href="https://www.jb51.cc/tag/zhuce/" target="_blank" class="keywords">注册</a>机开源 Dim S As Boolean,inf,Info Private Sub Command1_Click() S = False WebBrowser1.Navigate "https://passport.baidu.com/?reg®type=1®from=1&tpl=ik&u=http%3A//zhidao.baidu.com/regok.html%3Flogin%26t%3D1246074692593" Do While S = False DoEvents Loop Randomize For Each a In WebBrowser1.Document.getelementsbytagname("input") Select Case a.Name Case "username" a.Value = CLng(Rnd * 123456789 + 9999999) inf = "<a href="https://www.jb51.cc/tag/yonghuming/" target="_blank" class="keywords">用户名</a>:" & a.Value & vbCrLf Case "loginpass","verifypass" a.Value = "yanhuapiaopiao" Case "email" a.Value = "yhpp.ys168.com@qq.com" Case "verifycode" Set w = WebBrowser1.Document.getelementbyid("verifypic") Set w1 = WebBrowser1.Document.BODY.createcontrolrange w1.Add (w) w1.execCommand ("Copy") Picture1.Picture = Clipboard.GetData t = Input<a href="https://www.jb51.cc/tag/Box/" target="_blank" class="keywords">Box</a>("输入<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>框里的验证码") If Len(t) <> 4 Then Exit Sub a.Value = t Case "submit" a.Click Info = Info & inf Text1 = Info End Select Next End Sub Private Sub Form_Load() Info = "<a href="https://www.jb51.cc/tag/zhuce/" target="_blank" class="keywords">注册</a>的账号：（密码都是: yanhuapiaopiao ）" & vbCrLf End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object,URL As Variant) S = True End Sub

原文链接：https://www.f2er.com/vb/262395.html

vb实现网页自动填表

猜你在找的VB相关文章