有偿求助-Excel数据向公司内网自动填表的程序

zouhy0442 · 发表于 2020-4-30 10:44

因工作需要，经常需要把excel表格中的数据输入到公司内网的网页表单上，然后通过网页提交到公司内部数据库中。问题的难点是我自己没有Html，asp， js等网页程序经验，没有网页抓包等分析经验，搞不定如何定位到内网系统的一个个文本框，combobox等。

而且因为是公司内网，调试只能在本人电脑上进行，所以如果有上海地区的高手可以帮忙的话，本人愿意带电脑前往并给与一定的补偿；本人有一定的VBA基础，也附上在网上查找的一些自动填表的非系统方法，所以只需要您给出解决问题的思路和方法，对我进行点拨一下即可。有意者请微信：18917606732 或邮箱：zouhy0442@sina.com

zouhy0442 · 发表于 2020-4-30 10:47

PS，我是做机油研发的，美孚一号、嘉实多极护等都出自我公司，所以可以免费终身送全合成机油，只要我不失业的话，我电话13918969263

zouhy0442 · 发表于 2020-5-2 10:51

zpy2 发表于 2020-4-30 13:50
应该是没有权限或官方接口，只好自己抓包分析提交。。

是的，老美没给中国员工操作数据库的权限

zouhy0442 · 发表于 2020-5-2 11:06

HHAAMM 发表于 2020-4-30 23:29
html标签，一般都有name属性和id属性，name属性是可以重复的，有时候不能准确定位，id属性是不能重复的，所 ...

谢谢大神的回复和指点。一来这是美国总部10年前的系统，而且以前公司专门有负责数据录入的人，这两年外企日子艰难雇不起数据录入的人了，所以最近数据上传成了大问题；另外，这个系统做的比较变态，这些输入框的个数是不固定的，所以名称也是动态的：比如：A品牌的机油这次需要进行6项测试，系统默认是4行，我们点击下面的“Add Test" button，可以增加至6项；如果某个机油样品只需要测3项，只需要录入3项数据即可。最后，我也没有html的基础，F12找了半天也没发现这些包含这些input 的代码

zouhy0442 · 发表于 2020-5-2 11:12

话说，有没有上海的兄弟们，约起来，我带着电脑，带着钱，带着机油，带着诚意去求救？

zouhy0442 · 发表于 2020-5-2 11:32

不怕各位笑话，找了两天，没找到包含这些input 文本框或单选框的源代码； IE中按F12，只出现了三段比较短的小程序，而且公司的系统需要VPN 连到美国内网，所以没法发给大家测试。

zouhy0442 · 发表于 2020-5-2 11:50

deadzlq 发表于 2020-4-30 14:00
F12 查看Request 构造参数 Post

弱弱的问，是不是这样来查看Request参数？能不能给个示例教程或介绍？
我原来一直在debugger里面看，刚才看了一下发现很多有用的信息都在网络按钮中。PS：这个系统不支持在Chrome上查看，所以我只能用IE。

zouhy0442 · 发表于 2020-6-23 11:39

zpy2 发表于 2020-5-3 17:57
八仙过海各显神通，只要抓住老鼠就是好猫。
不管是那种方法，能解决问题就是好方法。

看到这么多大佬关注，还是很感动。花了两周时间学习了一下Python和Selenium，后来发现公司电脑不让安装Python（需要全球Tech Director approve）；只好退而求其次研究了一下DOM和老掉牙的对IE编程。基本解决了我的所有诉求，废话少说，直接上代码。

'---------------Fill Page 2---------------------------------------------------
Sub fill_GBTRS_P2()
Dim Cols(8) As Integer, i%, j%, RowLen%, ColsLen%, BORows%, BOCols%
Dim ObjChkbtn As Object, d As Object
Dim mShellwindows As New ShellWindows
Dim objIE As InternetExplorer
Dim objFrame As FramesCollection
Dim objDOC As HTMLDocument
Dim Gbtrs_frm As Object, MyTable As Object, MySelect As Object
Dim TestArr
Dim isSelect As Boolean, IEOpen As Boolean
Dim Address As String, rng1 As Range
Dim BOSum As Double
Address = Selection.Address
isSelect = False
Erase Cols
i = 4
Application.ScreenUpdating = False
'=======================connect with the opened GBTRS page===================================================
IEOpen = False
For Each objIE In mShellwindows
If objIE.LocationURL = "http://pap/" Then
IEOpen = True
Exit For
End If
Next
If Not IEOpen Then
MsgBox "Please Use Internet Explorer to open the PAP system. " & Chr(10) & Chr(10) & _
"This tool only support IE, use IE to open the work order Page 1! ", vbCritical, "Open IE First, Exit now"
Exit Sub
End If
While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Wend
Set objFrame = objIE.document.frames
Set objDOC = objFrame("LZMain").document
Set Gbtrs_frm = objDOC.frames("BrowseArea").document
'===================------------------------------select group tests by checkbox-----------------------------------============================
With ActiveSheet
For Each ObjChkbtn In .OLEObjects 'shapes("group").groupitems
If TypeName(ObjChkbtn.Object) = "CheckBox" Then
If ObjChkbtn.Object.Value = True Then
Cols(i) = CInt(Right(ObjChkbtn.Name, 1)) + 3
isSelect = True
End If
i = i + 1
End If
Next ObjChkbtn
End With
If Not isSelect Then Cols(4) = 4
TestArr = ThisWorkbook.Worksheets("Sheet1").ListObjects("Tests").Range
Set d = CreateObject("scripting.Dictionary")
For i = 2 To UBound(TestArr)
isSelect = False
For j = 4 To UBound(Cols)
If Cols(j) > 1 Then
If TestArr(i, Cols(j)) * 1 = 1 Then
isSelect = True
Exit For
End If
End If
Next j
If isSelect Then d(TestArr(i, 1)) = TestArr(i, 2) & StrLink & TestArr(i, 3) '---------put selected tests into dictionary
Next i
Erase TestArr
TestArr = d.keys
If ThisWorkbook.ActiveSheet.Cells(100, 100) <> RRFlag And Len(Cells(100, 100)) = 0 Then '====Locate Base Oil Table===========
'--------------------计算基础油行数，配方列，添加剂首行等参数
Application.ScreenUpdating = True '===================select data area=====================================
On Error Resume Next
Set rng1 = Application.InputBox("Please select ALL Base Oils in Column A", "Select All Base Oils", Address, , , , , Type:=8)
' Set rng2 = Application.InputBox("Please select torque reduction data columns at the same row as before", "Select results", Address, , , , , Type:=8)
On Error GoTo 0
If Not rng1 Is Nothing Then
BORows = rng1.Rows.Count
BOCols = 2
Do While WorksheetFunction.CountA(ActiveSheet.ListObjects("myFormulation").DataBodyRange.Columns(BOCols + 1)) > 2
BOCols = BOCols + 1
Loop
Set MyTable = Gbtrs_frm.getElementById("newblendstable")
RowLen = MyTable.Rows.Length
ColsLen = MyTable.Rows(0).Cells.Length
If BOCols > ColsLen - 5 Then BOCols = ColsLen - 4
Set rng1 = rng1.Resize(, BOCols)
Do While RowLen - 3 < BORows
MyTable.Rows(RowLen - 2).Cells(0).Children(0).Click
myDelay 0.2
RowLen = RowLen + 2
Loop
For j = 1 To BOCols
If j > 1 Then BOSum = WorksheetFunction.Sum(rng1.Columns(j))
For i = 1 To BORows '====================================fill baseoil part 基础油部分=======================================
If Len(rng1(i, j)) > 0 Then
If j = 1 Or BOSum = 100 Then
MyTable.Rows(i).Cells(j).Children(0).Value = rng1(i, j)
Else
MyTable.Rows(i).Cells(j).Children(0).Value = Format(100 * rng1(i, j) / BOSum, "0.00")
End If
End If
Next i
Next j
Set MyTable = Nothing
End If
Set rng1 = Nothing
On Error Resume Next
Do
Set rng1 = Application.InputBox("Please select ALL Components in Column A", "Select All Components", Address, , , , , Type:=8)
DoEvents
Loop Until Not rng1 Is Nothing
On Error GoTo 0
Application.ScreenUpdating = False
BORows = rng1.Rows.Count
BOCols = 2
Do While WorksheetFunction.CountA(ActiveSheet.ListObjects("myFormulation").DataBodyRange.Columns(BOCols + 1)) > 2
BOCols = BOCols + 1
Loop
Set MyTable = Gbtrs_frm.getElementById("newcompstable") 'getElementsByTagName("table")(1) 单剂部分
RowLen = MyTable.Rows.Length
ColsLen = MyTable.Rows(1).Cells.Length
If BOCols > ColsLen - 4 Then BOCols = ColsLen - 3
Set rng1 = rng1.Resize(, BOCols)
If BORows > RowLen - 4 Then Gbtrs_frm.parentWindow.execScript "morelines('newcompstable','comp'," & RowLen - 3 & "," & BORows - RowLen + 4 & ")", "JScript"
myDelay 0.3
For i = 1 To BORows '====================================fill ocmponents part=======================================
For j = 1 To BOCols
If Len(rng1(i, j)) > 0 Then MyTable.Rows(i).Cells(j).Children(0).Value = rng1(i, j)
Next j
Next i
Set MyTable = Nothing
Set rng1 = Nothing
End If
Set MyTable = Gbtrs_frm.getElementById("nonshivatable") '====------------------Locate test items Table 测试部分----------------===========
RowLen = MyTable.Rows.Length
ColsLen = MyTable.Rows(1).Cells.Length
BORows = d.Count
If BORows > RowLen - 4 Then Gbtrs_frm.parentWindow.execScript "morelines('nonshivatable','nonperf'," & RowLen - 3 & "," & BORows - RowLen + 6 & ")", "JScript"
myDelay 0.3
For i = 1 To BORows
Set MySelect = MyTable.Rows(i).Cells(0).Children(4)
' MySelect.selectedIndex = 5
MySelect.Value = "TPV00000R=10"
MySelect.FireEvent "onchange"
myDelay 0.1
With MyTable.Rows(i).Cells(0)
.Children(0).Value = TestArr(i - 1)
.Children(2).Value = Split(d(TestArr(i - 1)), StrLink)(0)
.Children(3).Value = Split(d(TestArr(i - 1)), StrLink)(1)
End With
Next i
Application.ScreenUpdating = True
MsgBox "Successfully fill all the data into the system", vbOKOnly
Set MyTable = Nothing
Set rng1 = Nothing
End Sub

复制代码

zouhy0442 · 发表于 2020-6-23 11:45

zpy2 发表于 2020-5-3 17:57
八仙过海各显神通，只要抓住老鼠就是好猫。
不管是那种方法，能解决问题就是好方法。

代码已上传，几点体会：
1. F12开发工具的元素选择（小箭头）是个好东西，点一下基本可以找到所有想要搜素的元素的名称和继承关系
2. Html网页中表格的遍历方法，及表格中输入框、选择框的选择方法children或childnodes表示可以简化程序；
3. 多个Frame跳转的技术
4. 执行html文件中某个元素事件的方法 fire event
5. 调用网页中已有的javascript方法，参数用单引号

		自动登录	找回密码
密码			免费注册

[求助] 有偿求助-Excel数据向公司内网自动填表的程序

点评

评分