求大侠帮忙实现自动填写网页表单，谢谢了，奉上全部身价一半

http://www.autohotkey.com

正宗的方法应该是调用WebBroswer控件。

WebBrowser

1.分析:2.调用Web 填表写法

来自三方案例..自己看着学习.给你一个学习方向...简单的还可以给你写..你这边层次太多...没空写.. 模块内容：
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SetForegroundWindow Lib "user32" (ByVal HWnd As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal HWnd As Long, lpPoint As POINTAPI) As Long
Type POINTAPI
     x As Long
     y As Long
End Type Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1 Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move '============================================
Sub 客户信息查询()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False Dim LinkX$, AccountNo$ Dim IE As Object
Dim file
Dim doc As Object  'MSHTML.HTMLDocument
Dim txt As String
Dim i&, j&, k&, H&, fgh$
Dim t1$, t2$, t3$, a, b, c, d
Dim webs, webs2, webs3, webs4, webs5, dmt, dmt1, dmt2, usrno
Dim strText$, Strtext1, Strtext2
Dim strname$, str, str1$, str1b$, str2$, str2b$, str3$, str4$, str5$, str6$, str7$, str8$, str9$, str12$, str13$, arr, arr1, arr2, arr3, arr4, arr5, Item&, URL, Url1&
Dim S0, S1, S2, S3, S4, S5, S6, S7, S8
Dim str10$, str11$, ShellApp As Object, SaveName$, ZipFolder$, TargetFile$
Dim v() As String, myjs, BRR
Dim cifno$, cifcname$, ResultLink$
Dim dj_x As Long, dj_y As Long, dj_num&, pdf_x As Long, pdf_y As Long
Dim dWinFolder As New ShellWindows, t
Dim objIE As Object, myHWND
Dim Czpmxurl As String, Czpmxname As String
Dim Czpmxhwnd As Long, aA        '窗口句柄'删除IE的Cache缓存，非常重要！
Call DeleteCacheURLList '--------------------------------------------------------------------------------------------------------MIS登录
'webs = ThisWorkbook.Sheets("Para1").Cells(221, 2).Value
Set IE = CreateObject("InternetExplorer.Application") With ThisWorkbook.Sheets("Para1")
     webs = .Cells(224, 2).Value & .Cells(222, 2).Value & .Cells(224, 4).Value & ChangeYZGPassword(.Cells(223, 2).Value) & .Cells(224, 6).Value & .Cells(224, 7).Value
     'Debug.Print webs
     usrno = .Cells(222, 2)   '登录用户号参数IE.Navigate webs
IE.Visible = True     '若=0 False不显示 ,=1 True 显示
IE.Silent = True 'Application.WindowState = xlMaximized   '窗体最大化'----------------------------------------------------------------登录完成ok
Do While IE.Busy Or IE.ReadyState <> 4
     DoEvents
Loop '网页执行效率太低只好多等一会儿:-(
Application.Wait now + TimeValue("00:00:10") Set dmt = IE.Document
IE.Document.getElementById("condition").Value = .Cells(226, 3)
IE.Document.getElementById("context").Focus
IE.Document.getElementById("context").Value = .Cells(227, 3)
IE.Document.getElementById("context").Click Application.Wait now + TimeValue("00:00:03")
IE.Document.getElementById("context").Focus
SendKeys "{enter}"
SendKeys "{enter}"    '回车开始查询End With Do While IE.Busy Or IE.ReadyState <> 4
     DoEvents
Loop '---------------------------------------------------------
Application.Wait now + TimeValue("00:00:05") '-------------------------------------------------------------查找弹出窗口并控制它以取出网页的innerhtml     Do
         For Each objIE In dWinFolder
             If InStr(1, objIE.LocationURL, "customer.php?action=customerdetail&cifno=") > 0 Then
                 Czpmxname = objIE.LocationName            '标题
                Czpmxurl = objIE.LocationURL              '链接
                Exit Do   '通过链接objIE.LocationURL包含的关键字查询，或用objIE.LocationName即窗口标题包含的关键字来查询
            End If
         Next
         DoEvents
     Loop

     '此处借用的老师提供链接示例中的代码，非常感谢！
    IE.Document.parentwindow.Eval "javascript:window.opener=null;window.open('','_self');window.close();"    '在原ie窗口中打开
    Set IE = objIE  '转换ie窗口控制权终于成功了
    Do Until IE.ReadyState = 4 And IE.Busy = False
         DoEvents
     Loop
     Set dmt = IE.Document
     'Debug.Print dmt.body.innerhtml
     '------------------------------------------------------------已成功取得弹出ie窗口页面innerhtml

      For i = 0 To dmt.Links.Length - 1
            If dmt.Links(i).innertext = "综合账单" Then
               Debug.Print "Links(i) i=" & i
               dmt.Links(i).Click
               DoEvents
               Exit For
            End If
        Next

    Application.Wait now + TimeValue("00:00:05")


'Set obj1 = IE.Document.frames
'i = 0
'On Error GoTo showmsg:
'While 1
'strname = strname & Chr(10) & obj1.Item(i).Name
'i = i + 1
'Wend
'showmsg:
'Debug.Print "本网页中有 " & i & " 个框架:" & strname
'经测试共有2个框架,目标按钮"btn_ok1"在第2个框架内
'Debug.Print IE.Document.frames(0).Document.body.innerhtml
'Debug.Print IE.Document.frames(0).Location
'Debug.Print IE.Document.frames(1).Document.body.innerhtml
'Debug.Print IE.Document.frames(1).Location If InStr(1, IE.Document.frames(1).Document.body.innerhtml, "Pdf对账单") > 0 Then
    'id=btn_ok1
    Debug.Print "已找到生成pdf对账单的按钮"
Else
     Exit Sub
End If IE.Document.frames(1).Document.getElementById("btn_ok1").Click   '点击按钮下载文件    t = Timer
     Do Until FindWindow(vbNullString, "文件下载") > 0
         DoEvents
     Loop

     Application.Wait now + TimeValue("00:00:03")
     SendKeys "^s"
     '------------------------------------------------------------------------------
    Do Until FindWindow(vbNullString, "另存为") > 0
         DoEvents
     Loop
     Application.Wait now + TimeValue("00:00:03")
     SaveName = ThisWorkbook.path & "\CheckYZG\" & "对账单_" & cifcname & "_" & Format(now(), "yyyymmddhhmmss") & ".pdf"
     SendKeys SaveName
     SendKeys "%s"
      '======================================================================
'IE.Quit                   '关闭ie
'或:Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")
ex:
     Application.Wait now + TimeValue("00:00:02")  '关闭弹出ie窗口

     Czpmxhwnd = FindWindow(vbNullString, Czpmxname & " - Windows Internet Explorer")       '根据窗口标题查找，找到后返回句柄
    If Czpmxhwnd <> 0 Then
         Debug.Print "已经找到指定弹出ie窗口并将关闭之"
         aA = SetForegroundWindow(Czpmxhwnd)    '将网页调到前台
        Application.Wait now + TimeValue("00:00:01") ''   程序休息
        SendKeys "%{F4}"
         'SendKeys "{ENTER}", True
     End If



     '退出原ie窗口
    IE.Quit
     Application.Wait now + TimeValue("00:00:02") ''   程序休息
    SendKeys "{ENTER}", True

     Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")

     Set IE = Nothing


     '打开pdf下载文件目录
    'Application.Wait now + TimeValue("00:00:03")
     Shell "explorer.exe /n,/e," & ThisWorkbook.path & "\CheckYZG\", vbMaximizedFocus
     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
End Sub

来自三方案例..自己看着学习.给你一个学习方向...简单的还可以给你写..你这边层次太多...没空写.. 模块内容：
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SetForegroundWindow Lib "user32" (ByVal HWnd As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal HWnd As Long, lpPoint As POINTAPI) As Long
Type POINTAPI
     x As Long
     y As Long
End Type Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1 Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move '============================================
Sub 客户信息查询()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False Dim LinkX$, AccountNo$ Dim IE As Object
Dim file
Dim doc As Object  'MSHTML.HTMLDocument
Dim txt As String
Dim i&, j&, k&, H&, fgh$
Dim t1$, t2$, t3$, a, b, c, d
Dim webs, webs2, webs3, webs4, webs5, dmt, dmt1, dmt2, usrno
Dim strText$, Strtext1, Strtext2
Dim strname$, str, str1$, str1b$, str2$, str2b$, str3$, str4$, str5$, str6$, str7$, str8$, str9$, str12$, str13$, arr, arr1, arr2, arr3, arr4, arr5, Item&, URL, Url1&
Dim S0, S1, S2, S3, S4, S5, S6, S7, S8
Dim str10$, str11$, ShellApp As Object, SaveName$, ZipFolder$, TargetFile$
Dim v() As String, myjs, BRR
Dim cifno$, cifcname$, ResultLink$
Dim dj_x As Long, dj_y As Long, dj_num&, pdf_x As Long, pdf_y As Long
Dim dWinFolder As New ShellWindows, t
Dim objIE As Object, myHWND
Dim Czpmxurl As String, Czpmxname As String
Dim Czpmxhwnd As Long, aA        '窗口句柄'删除IE的Cache缓存，非常重要！
Call DeleteCacheURLList '--------------------------------------------------------------------------------------------------------MIS登录
'webs = ThisWorkbook.Sheets("Para1").Cells(221, 2).Value
Set IE = CreateObject("InternetExplorer.Application") With ThisWorkbook.Sheets("Para1")
     webs = .Cells(224, 2).Value & .Cells(222, 2).Value & .Cells(224, 4).Value & ChangeYZGPassword(.Cells(223, 2).Value) & .Cells(224, 6).Value & .Cells(224, 7).Value
     'Debug.Print webs
     usrno = .Cells(222, 2)   '登录用户号参数IE.Navigate webs
IE.Visible = True     '若=0 False不显示 ,=1 True 显示
IE.Silent = True 'Application.WindowState = xlMaximized   '窗体最大化'----------------------------------------------------------------登录完成ok
Do While IE.Busy Or IE.ReadyState <> 4
     DoEvents
Loop '网页执行效率太低只好多等一会儿:-(
Application.Wait now + TimeValue("00:00:10") Set dmt = IE.Document
IE.Document.getElementById("condition").Value = .Cells(226, 3)
IE.Document.getElementById("context").Focus
IE.Document.getElementById("context").Value = .Cells(227, 3)
IE.Document.getElementById("context").Click Application.Wait now + TimeValue("00:00:03")
IE.Document.getElementById("context").Focus
SendKeys "{enter}"
SendKeys "{enter}"    '回车开始查询End With Do While IE.Busy Or IE.ReadyState <> 4
     DoEvents
Loop '---------------------------------------------------------
Application.Wait now + TimeValue("00:00:05") '-------------------------------------------------------------查找弹出窗口并控制它以取出网页的innerhtml     Do
         For Each objIE In dWinFolder
             If InStr(1, objIE.LocationURL, "customer.php?action=customerdetail&cifno=") > 0 Then
                 Czpmxname = objIE.LocationName            '标题
                Czpmxurl = objIE.LocationURL              '链接
                Exit Do   '通过链接objIE.LocationURL包含的关键字查询，或用objIE.LocationName即窗口标题包含的关键字来查询
            End If
         Next
         DoEvents
     Loop

     '此处借用的老师提供链接示例中的代码，非常感谢！
    IE.Document.parentwindow.Eval "javascript:window.opener=null;window.open('','_self');window.close();"    '在原ie窗口中打开
    Set IE = objIE  '转换ie窗口控制权终于成功了
    Do Until IE.ReadyState = 4 And IE.Busy = False
         DoEvents
     Loop
     Set dmt = IE.Document
     'Debug.Print dmt.body.innerhtml
     '------------------------------------------------------------已成功取得弹出ie窗口页面innerhtml

      For i = 0 To dmt.Links.Length - 1
            If dmt.Links(i).innertext = "综合账单" Then
               Debug.Print "Links(i) i=" & i
               dmt.Links(i).Click
               DoEvents
               Exit For
            End If
        Next

    Application.Wait now + TimeValue("00:00:05")


'Set obj1 = IE.Document.frames
'i = 0
'On Error GoTo showmsg:
'While 1
'strname = strname & Chr(10) & obj1.Item(i).Name
'i = i + 1
'Wend
'showmsg:
'Debug.Print "本网页中有 " & i & " 个框架:" & strname
'经测试共有2个框架,目标按钮"btn_ok1"在第2个框架内
'Debug.Print IE.Document.frames(0).Document.body.innerhtml
'Debug.Print IE.Document.frames(0).Location
'Debug.Print IE.Document.frames(1).Document.body.innerhtml
'Debug.Print IE.Document.frames(1).Location If InStr(1, IE.Document.frames(1).Document.body.innerhtml, "Pdf对账单") > 0 Then
    'id=btn_ok1
    Debug.Print "已找到生成pdf对账单的按钮"
Else
     Exit Sub
End If IE.Document.frames(1).Document.getElementById("btn_ok1").Click   '点击按钮下载文件    t = Timer
     Do Until FindWindow(vbNullString, "文件下载") > 0
         DoEvents
     Loop

     Application.Wait now + TimeValue("00:00:03")
     SendKeys "^s"
     '------------------------------------------------------------------------------
    Do Until FindWindow(vbNullString, "另存为") > 0
         DoEvents
     Loop
     Application.Wait now + TimeValue("00:00:03")
     SaveName = ThisWorkbook.path & "\CheckYZG\" & "对账单_" & cifcname & "_" & Format(now(), "yyyymmddhhmmss") & ".pdf"
     SendKeys SaveName
     SendKeys "%s"
      '======================================================================
'IE.Quit                   '关闭ie
'或:Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")
ex:
     Application.Wait now + TimeValue("00:00:02")  '关闭弹出ie窗口

     Czpmxhwnd = FindWindow(vbNullString, Czpmxname & " - Windows Internet Explorer")       '根据窗口标题查找，找到后返回句柄
    If Czpmxhwnd <> 0 Then
         Debug.Print "已经找到指定弹出ie窗口并将关闭之"
         aA = SetForegroundWindow(Czpmxhwnd)    '将网页调到前台
        Application.Wait now + TimeValue("00:00:01") ''   程序休息
        SendKeys "%{F4}"
         'SendKeys "{ENTER}", True
     End If



     '退出原ie窗口
    IE.Quit
     Application.Wait now + TimeValue("00:00:02") ''   程序休息
    SendKeys "{ENTER}", True

     Shell ("C:\Program Files\Internet Explorer\IEXPLORE.exe about:blank")

     Set IE = Nothing


     '打开pdf下载文件目录
    'Application.Wait now + TimeValue("00:00:03")
     Shell "explorer.exe /n,/e," & ThisWorkbook.path & "\CheckYZG\", vbMaximizedFocus
     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
End Sub大侠，可以帮我写一下，照片上传那部分代码吗？？？？谢谢了

建议改成vb.net强大的编程语言

调试易

求大侠帮忙实现自动填写网页表单，谢谢了，奉上全部身价一半

解决方案 »

求大侠帮忙实现 自动填写 网页表单，谢谢了，奉上全部身价一半

解决方案 »

求大侠帮忙实现自动填写网页表单，谢谢了，奉上全部身价一半