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

hlgj988 2017-03-27 11:05:54
如题:
http://nanning.baixing.com/fabu/ershouqiche

实现 自动填写 网页表单,上传图片,要求全源码,辛苦了,各位大侠。
...全文
1364 18 打赏 收藏 转发到动态 举报
写回复
用AI写文章
18 条回复
切换为时间正序
请发表友善的回复…
发表回复
程序混混 2017-04-28
  • 打赏
  • 举报
回复
建议改成vb.net强大的编程语言
「已注销」 2017-04-19
  • 打赏
  • 举报
回复
用按键精灵啊,哈哈哈哈哈哈,网页填表跟模拟按键有啥区别,还不如按键精灵快捷还不用那么麻烦。
hlgj988 2017-04-12
  • 打赏
  • 举报
回复
hlgj988 2017-04-10
  • 打赏
  • 举报
回复
hlgj988 2017-04-05
  • 打赏
  • 举报
回复
引用 13 楼 kk251357 的回复:
[quote=引用 11 楼 hlgj988 的回复:] [quote=引用 10 楼 qq_32337999 的回复:] 1.分析: 2.调用Web 填表写法
第一个问题: 怎么样才能实现 点击 “填写一个” 这个链接,点击之后,就可以自己填写一个标题了,就可以避免一系列的下拉菜单。 第二个问题: 怎么样实现自动选择 车辆颜色。 第三个问题(最难,最重要): 怎么样才能实现自动上传照片。 劳烦这位大侠,可以写一点代码给我,慢慢研究,谢谢了。 [/quote] 来自三方案例..自己看着学习.给你一个学习方向...简单的还可以给你写..你这边层次太多...没空写.. 模块内容: 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 [/quote] 大侠,可以帮我写一下,照片上传那部分代码吗????谢谢了
vansoft 2017-04-02
  • 打赏
  • 举报
回复
大侠都很忙的。他们要去拯救世界。
守候ED 2017-04-02
  • 打赏
  • 举报
回复
引用 11 楼 hlgj988 的回复:
[quote=引用 10 楼 qq_32337999 的回复:]
1.分析:



2.调用Web 填表写法

第一个问题:
怎么样才能实现 点击 “填写一个” 这个链接,点击之后,就可以自己填写一个标题了,就可以避免一系列的下拉菜单。

第二个问题:
怎么样实现自动选择 车辆颜色。

第三个问题(最难,最重要):
怎么样才能实现自动上传照片。

劳烦这位大侠,可以写一点代码给我,慢慢研究,谢谢了。

[/quote]











来自三方案例..自己看着学习.给你一个学习方向...简单的还可以给你写..你这边层次太多...没空写..

模块内容:
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

hlgj988 2017-03-31
  • 打赏
  • 举报
回复
引用 10 楼 qq_32337999 的回复:
1.分析: 2.调用Web 填表写法
第一个问题: 怎么样才能实现 点击 “填写一个” 这个链接,点击之后,就可以自己填写一个标题了,就可以避免一系列的下拉菜单。 第二个问题: 怎么样实现自动选择 车辆颜色。 第三个问题(最难,最重要): 怎么样才能实现自动上传照片。 劳烦这位大侠,可以写一点代码给我,慢慢研究,谢谢了。
qq_32337999 2017-03-31
  • 打赏
  • 举报
回复
1.分析:



2.调用Web 填表写法

赵4老师 2017-03-30
  • 打赏
  • 举报
回复
WebBrowser
赵4老师 2017-03-30
  • 打赏
  • 举报
回复
正宗的方法应该是调用WebBroswer控件。
笨狗先飞 2017-03-30
  • 打赏
  • 举报
回复
提示一下,利用一下浏览器的开发人员工具,不论它内容怎么变,它提交给服务器的数据就那些,追踪一下往来数据就有底了
赵4老师 2017-03-29
  • 打赏
  • 举报
回复
hlgj988 2017-03-29
  • 打赏
  • 举报
回复
引用 5 楼 zhao4zhong1 的回复:
http://www.autohotkey.com
无·法 2017-03-28
  • 打赏
  • 举报
回复
淘宝上找人定制,估算价格大概500元
无·法 2017-03-28
  • 打赏
  • 举报
回复
引用 2 楼 hlgj988 的回复:
[quote=引用 1 楼 sysdzw 的回复:] 淘宝上找人定制,估算价格大概500元
以前我也成功做出来了,但现在 百姓网 好像全部用脚本了,我就搞不定了,所以来求助大侠。[/quote]这儿是学习交流的啊,针对具体问题。你这个是项目外包呀。
hlgj988 2017-03-28
  • 打赏
  • 举报
回复
引用 1 楼 sysdzw 的回复:
淘宝上找人定制,估算价格大概500元
以前我也成功做出来了,但现在 百姓网 好像全部用脚本了,我就搞不定了,所以来求助大侠。
hlgj988 2017-03-28
  • 打赏
  • 举报
回复
引用 3 楼 sysdzw 的回复:
[quote=引用 2 楼 hlgj988 的回复:] [quote=引用 1 楼 sysdzw 的回复:] 淘宝上找人定制,估算价格大概500元
以前我也成功做出来了,但现在 百姓网 好像全部用脚本了,我就搞不定了,所以来求助大侠。[/quote]这儿是学习交流的啊,针对具体问题。你这个是项目外包呀。[/quote]
引用 3 楼 sysdzw 的回复:
[quote=引用 2 楼 hlgj988 的回复:] [quote=引用 1 楼 sysdzw 的回复:] 淘宝上找人定制,估算价格大概500元
以前我也成功做出来了,但现在 百姓网 好像全部用脚本了,我就搞不定了,所以来求助大侠。[/quote]这儿是学习交流的啊,针对具体问题。你这个是项目外包呀。[/quote] 或者给一些提示或者指导,谢谢

1,502

社区成员

发帖
与我相关
我的任务
社区描述
VB 网络编程
社区管理员
  • 网络编程
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧