有一个网页的填表，它是这样的流程：1.第一个页面，只有submit进入下一页按钮，点击；2、进入第二个页面，填表，有姓名、性别、邮箱，填表完毕后点击submit进入下一页；3，进入第三个页面，填密码，最后点击提交按钮！

我用了判断URL的代码让上面的流程合起来自动填表，就是自动化的意思，从第一步到最后一步都是点击1个按钮就完成，但老是实现不了，不知为什么，请问可以给下主要代码我参考一下吗？或者是可以用其它方法来判断实现吗？谢谢！

当 webbrows 载完一个网页时，会产生一个事件，这个事件中会返回 载入完成 的网页的 URL 。

当这个事件发生时，判断这个 URL ，然后根据这个URL 进行分支选择。
如 =1 时
   直接提交表单。
  =2 时
    填写姓名、性别 等，然后再提交表单。
  =3 时
    填密码 ，再提交表单。
  =其它 时
    不处理。


发以前写一个处理过程，慢慢看。

Private Sub Web1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

On Error Resume Next

请求数据处理 = 未处理           '设置为处理了

Dim doc As String
Dim doctext
    Dim i As Long
    Dim j As Long
    Dim k As String

Set doctext = Web1.Document.body.createTextRange()
doc = doctext.htmltext

'断线处理
If InStr(1, URL, "login.cfm?message=") > 0 Then              '提示未登录,重上线
    Call Command2_Click
    Exit Sub
End If

If InStr(1, doc, "无法显示网页") > 0 Then         '打开网页失败,重上线
    Call Command2_Click
    Exit Sub
End If

If InStr(1, doc, "无法找到服务器") > 0 Then         '找不到服务器,重上线
    Call Command2_Click
    Exit Sub
End If

If InStr(1, URL, 代理中国URL) > 0 Then              '解析代理服务器
    Call 解析代理服务器(doc)
End If

If InStr(1, doc, "请不要频繁刷新网页") > 0 Then         '刷新警告，回滚
    Call 回滚被冲洗的自动封包
End If

If InStr(1, URL, ".cfm") > 0 Then
    If 游戏URL = "" Then
        
        i = InStr(1, URL, "/")
        Do While i > 0
            j = i
            i = InStr(i + 1, URL, "/")
        Loop
        
        '取游戏的地址,
        游戏URL = Left(URL, j)
        
        游戏COOKIE = Web1.Document.Cookie
        Timer1.Enabled = True
    End If
    '自动处理请求数据 = 0
    
    '处理所有数据
    
    If InStr(1, doc, "parent.document.getElementById('NewMessage').src='skin/index/28") > 0 Then            '含消息数据,说明前面的都有了
        
        If Not 本月消息提示 Then            '如果本月已提示,则不再提示了.
            If InStr(1, doc, "parent.document.getElementById('NewMessage').src='skin/index/28.gif") > 0 Then
                Call 提示框.start(用户名)
                本月消息提示 = True
            End If
        End If
        
        Call HTML中取地(doc, 1)     '统一在此解析
        Call HTML中取地(doc, 2)
        Call HTML中取地(doc, 3)
        Call 显示地
        
        Call 解析资源属性包(doc)
        If 用户名2 = "" And 用户名 <> "" Then
            用户名2 = 用户名
        End If
        
        If 用户名2 <> "" And 用户名 <> "" Then      '串号
            If 用户名2 <> 用户名 Then
                Call Command2_Click                 '串号,重登录
            End If
        End If
        Call 显示资源
    End If
End If

If InStr(1, URL, gamehomeurl) > 0 And 自动处理请求数据(0) = 未处理 Then        '游戏首页
    If 用户名 = "" And 自动处理请求数据(0) = 未处理 Then
        自动处理请求数据(0) = 请求数据
        Call 增加挂机自动封包1(生产建设URL, "", "读建筑属性")                        '读建筑属性
        Call 增加挂机自动封包1(军事管理URL, "", "读兵的名称")                        '读地\资源\兵的种类
        Call 增加挂机自动封包1(我的英雄URL, "", "读英雄列表")                        '读英雄数据
      
        Call 增加挂机自动封包1(gamehomeurl, "", "返回首页")                        '返回首页
    End If
End If

If InStr(1, Web1.Document.URL, 生产建设URL) > 0 Then
    If Not 是否解析了建筑属性包 Then
        Call 解析建筑属性包(doc)
        Call 更新建筑

        If Label6.Caption <> 用户名 Then
            Label6.Caption = 用户名
            Me.Caption = "帝国远征辅助---" & 用户名
        End If
        
        是否解析了建筑属性包 = True
    End If
End If

If InStr(1, Web1.Document.URL, 军事管理URL) > 0 Then
    
    'Call 记录日志(doc)
    
    Call 解析武器包(doc)
    
    Call 解析部队训练包(doc)            '每次都要解析兵能训练的数量
    
    If Not 是否解析了兵属性包 Then
        Call Command23_Click        '显示部队
        是否解析了兵属性包 = True
        Label6.Caption = 用户名
        Me.Caption = "帝国远征辅助---" & 用户名
    End If
       If 自动处理请求数据(0) = 请求数据 Then
        Call 保留登录地址
        Call 读取设置(用户名)
        'Web1.Navigate 游戏URL & "index.cfm"
        自动处理请求数据(0) = 发送数据
    End If
    
    If Check3.Value > 0 Then                                '解析部队包后,先做建筑,再补兵
        If 自动处理请求数据(自动建筑) = 请求数据 Then           '正在请求数据,需要生成建筑包
            If Check2(0).Value > 0 Then
                Call 生成自动建筑封包
            End If
        End If

        If Check2(4).Value > 0 And 自动处理请求数据(自动补兵) = 请求数据 Then
            Call 生成自动补兵包
        End If
    End If
    
End If

If InStr(1, Web1.Document.URL, 我的英雄URL) > 0 Then
    '取英雄
    Call 解析英雄属性包(doc)
    Call 显示英雄
        
    '优先 探险
    If Check2(5).Value = 0 Then                     '没有设置自动打怪
        If Check3.Value > 0 And 自动处理请求数据(自动英雄) = 请求数据 And Check2(3).Value > 0 Then          '派将探索
            Call 生成英雄探险封包
        End If
    End If
    
    If Check3.Value > 0 And Check2(5).Value > 0 And Check10.Value = 0 Then      '如果选了打怪,并且非自动选怪时,收到英雄数据后,就开始
        If 自动处理请求数据(自动打怪) = 请求数据 Then        '否则,立即开始派兵.
            Call 生成自动打怪
        End If
    End If

End If

If InStr(1, Web1.Document.URL, "Festal_GetFreeNum_NewPlayer.cfm") > 0 Then          '如果转新手转盘
    i = InStr(1, doc, "FreeNum")
    If i > 0 Then
        i = InStr(i, doc, "class=tx>")
        If Mid(doc, i + 9, 1) > "0" Then
            i = Rnd() * 2147483647
            Call 增加挂机自动封包1("Festal_GetAwardXml_NewPlayer.cfm?id=" & i, "", "转新手转盘")
        End If
    End If
End If

If Check3.Value > 0 Then                '选了挂机后

    If InStr(1, Web1.Document.URL, 探地封包.URL) > 0 Then
        
        可派探地人员 = CLng(HTML中取数字(doc, "指派 <INPUT size=5 value"))
        探地耗粮 = CLng(HTML中取数字(doc, "一个探索者，需要"))
        
        If 可派探地人员 > 0 Then
    
            If Check2(1).Value > 0 And 自动处理请求数据(自动探地) = 请求数据 Then         '正在请求数据,需要生成建筑包
                '生成探地封包
                Call 生成自动探地封包
            End If
        End If
    End If
    
    
    If InStr(1, URL, 市场贸易URL) > 0 Then                '市场
        
        最大交易量 = HTML中取数字(doc, "还能交易")
    
        If 最大交易量 > 0 Then
            If Check2(6).Value > 0 And 自动处理请求数据(自动援助) = 请求数据 Then       '自动援助
                Call 生成自动援助封包
            Else
                If Check2(2).Value > 0 And 自动处理请求数据(自动卖货) = 请求数据 Then       '自动卖货
                    Call 生成自动卖货封包
                End If
            End If
            
        End If
    End If

    If Check10.Value > 0 Then       '如果自动怪物,则判断是否为地图

        If InStr(1, Web1.Document.URL, "map.cfm") > 0 Then          '自动刷新的地图
            
            If 自动处理请求数据(自动地图) = 请求数据 Then
                Call 解析怪物数据(doc)
                Call 计算自动兵力
            End If
            
        End If
    End If

    If Check31.Value > 0 And 自动处理请求数据(自动提炼) = 请求数据 Then
        If InStr(1, URL, 提炼封包.URL) > 0 Then
            If InStr(1, doc, "您当前没有晶矿提炼场") > 0 Then       '没的提炼场
                'Check31.Value =0                        '取消提炼功能
            Else
                k = 解析晶石ID(doc)
                If Len(k) > 0 Then
                    Call 增加挂机自动封包1(k, "", "自动提炼晶石")
                End If
            End If
            自动处理请求数据(自动提炼) = 发送数据
        End If
    End If



End If

If InStr(1, URL, 选马URL) > 0 Then          '选马
    Call 解析资源属性包(doc)
    Call 显示资源
    Call 分解马数据(doc)
End If

If Check23.Value > 0 Then           '扫货
If InStr(1, Web1.Document.URL, 自动扫货URL) > 0 Then

    Call 自动扫货处理(doc, Combo14.Text)
    'Stop
End If
End If


If InStr(1, URL, 设计图纸URL) > 0 Then          '分析设计图纸
    
    i = InStr(1, URL, "=")
    If i > 0 Then
        j = CLng(Mid(URL, i + 1))
    Else
        j = 1
    End If
    
    Call 分析图纸(doc, j)
End If

End Sub

非常感谢！不过我代码出现：错误91，对象变量或with块变量未设置。是个填表自动化的问题。流程：1.第一个页面，只有submit进入下一页按钮，点击；2、进入第二个页面，填表，有q1和q2两项， 填表完毕后点击submit提交。

Private Sub WebBrowser6_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim tg5
Dim d5
Dim doc5 As String
Dim doctext
Dim i As Long

Set doctext = WebBrowser6.Document.body.createTextRange()
Set d5 = WebBrowser6.Document
doc5 = doctext.htmltext

For i = 0 To d5.All.length - 1
Set tg5 = d5.All(i)
    If LCase(d5.All(i).tagName) = "input" Or LCase(d5.All(i).tagName) = "select" Then
        If InStr(1, doc5, "开始") > 0 Then
              If tg5.Type = "submit" Then
              tg5.Click
               End If
        End If
        If InStr(1, doc5, "signup/cc/page1") > 0 Then
             If tg5.Type = "radio" Then
                Select Case tg5.Name
                 Case "q1"
                 tg5.Value = "7"
                 Case "q2"
                 tg5.Value = "2"
                End Select
             ElseIf tg5.Type = "submit" Then
                 tg5.Click
            End If
        End If
    End If
Next i
End Sub

请问哪里出问题了？

上面的代码问题我知道错在哪了，现在是以下这个关键问题：
Private Sub Command1_Click()
WebBrowser6.Navigate "

Private Sub Command2_Click()
Dim tg5
Dim d5
Dim doc5 As String
Dim doctext
Dim i As Long


Set doctext = WebBrowser1.Document.body.createTextRange()
Set d5 = WebBrowser1.Document
doc5 = doctext.htmltext

For i = 0 To d5.All.length - 1
Set tg5 = d5.All(i)
    If LCase(d5.All(i).tagName) = "input" Or LCase(d5.All(i).tagName) = "select" Then
        If InStr(1, doc5, "开始") > 0 Then
              If tg5.Type = "submit" Then
              tg5.Click
               End If   
        End If
        If InStr(1, doc5, "signup/page1") > 0 Then
             If tg5.Type = "radio" Then
                Select Case tg5.Name
                 Case "q1"
                 tg5.Value = "7"
                 Case "q2"
                 tg5.Value = "2"
                End Select
             ElseIf tg5.Type = "submit" Then
                 tg5.Click
            End If
        End If
    End If
Next i
End Sub
点击了第1页 的注册按钮后，第二页的填表和按钮就完全不执行了，我觉得If InStr(1, doc5, "开始") > 0 Then 和If InStr(1, doc5, "signup/page1") > 0 Then在这里没有起作用，请问如何修改？

这种的提交 表单，我没用过，填表和 提交 ，你可以试一下 使用 JS 来提交，你搜索一下站网，自动填表方面的，有一个贴子说明了这个 JS 函数的写法和调用方式。

我前面那个代码对应的 提交函数是自己写的 POST 函数进行提交的。所以不使用按钮。

Private Sub 发POST包(数据 As String, URL As String)
    On Error Resume Next
    Dim poststr() As Byte
    poststr = StrConv(数据, vbFromUnicode)
    Web1.Navigate  URL, , , poststr, "Content-Type: application/x-www-form-urlencoded"
End Sub