求助！求助 vba从网页中提取数据

谢礼军 · 发表于 2018-8-8 09:30

mxf21cn 发表于 2018-8-7 22:45
Ctrl+F 搜索用户名cqgytyy或者密码123456会有黄色标记的会话，点开RAW就是下面的内容

POST http:// ...

老师我看不懂啊可以给我一个完整的vba语句吗？现在每天手动在网站查数据，拜托你了。

chis3 · 发表于 2018-8-8 09:45

谢礼军发表于 2018-8-8 09:30
老师我看不懂啊可以给我一个完整的vba语句吗？现在每天手动在网站查数据，拜托你了。

你連照抄那個stop也不懂自己刪除
連基本的基本也不懂,給你做好也有很多情況出現問題也不會解決啊

fxl447098457 · 发表于 2018-8-8 11:41

可以看看。。

结果如下：

chis3 · 发表于 2018-8-8 20:17

mxf21cn 发表于 2018-8-7 22:45
Ctrl+F 搜索用户名cqgytyy或者密码123456会有黄色标记的会话，点开RAW就是下面的内容

POST http:// ...

在http://fdm.yyjzt.com/search/merc ... category&page=1
或
http://fdm.yyjzt.com/
在fidldler中找cqgytyy
都沒找到黃色
為什麼?

谢礼军 · 发表于 2018-8-9 14:22

fxl447098457 发表于 2018-8-8 11:41
可以看看。。

结果如下：

谢谢大神，你帮了我很大的忙，给我工作提高了非常很大效率。太感谢了，万分感谢，好人一生平安！

谢礼军 · 发表于 2018-8-16 19:31

本帖最后由谢礼军于 2018-8-16 20:04 编辑

fxl447098457 发表于 2018-8-7 12:22
人家的stop只是拿来断点测试的。我也是醉了。你这是小白中的小白的。

Sub gedata()
Dim ie As Object, http As Object, dom As Object, win As Object, strtext As String
Dim url As String, arr, i&, k&, brr(), stock As String
Set http = CreateObject("msxml2.xmlhttp")
Set dom = CreateObject("htmlfile")
Set win = dom.parentwindow
UserName = "cqgytyy"
Password = "123456"
With http
   .Open "post", "http://fdm.yyjzt.com/user/topLogin.json", False
   .setrequestheader "content-type", "application/x-www-form-urlencoded;charset=UTF-8"
   .send "jzt_username=" & UserName & "&jzt_password=" & Password
   dom.write "<script src=""http://ajax.microsoft.com/ajax/jquery/jquery-1.4.min.js""></script><body></body>"

   For Page = 1 To 1 '抓取2页
      url = "http://fdm.yyjzt.com/search/merchandise.htm?keyword&category&page=" & Page
      .Open "GET", url, False
      .send
      Do
         DoEvents
      Loop Until .Status = 200
      arr = Split(.responsetext, "<table")
      For i = 1 To UBound(arr)
         dom.body.innerhtml = "<table>" & Split(arr(i), "</table>")(0) & "</table>"
         k = k + 1: ReDim Preserve brr(1 To 7, 1 To k)
         brr(1, k) = win.eval("$('a').contents().filter(function(){return this.nodeType==3;}).text()")
         brr(2, k) = win.eval("$('td a span.u_goods_spec').eq(0).text()")
         brr(3, k) = win.eval("$('td p.u_goods_com').eq(0).text()")
         brr(4, k) = win.eval("$('td span.u_goods_pric').eq(0).text()")
         brr(5, k) = win.eval("$('td p span.m_tag_kw').eq(1).text()")
         stock = Split(Split(arr(i - 1), "u_goods_txt"">")(1), "<")(0)
         brr(6, k) = re(stock)
         brr(7, k) = win.eval("$('a) p class.u_goods_txt').eq(0).text()")

         Next
      Application.Wait (Now + TimeValue("0:00:05")) '休息10秒
   Next
   [a1:g1] = [{"药品名称","规格","厂家","销售价格","件装","库存","效期"}]
   [a2].Resize(k, 7) = Application.Transpose(brr)
   [a:g].EntireColumn.AutoFit
End With
End Sub
Function re(str)
With CreateObject("vbscript.regexp")
   .Pattern = "\s+"
   .Global = True
   re = .Replace(str, "")
End With
End Function

范老师你好，  领导又要求抓取有效期，我按照你的代码找到网页的源代码，找到语句，brr(7, k) = win.eval("$('a) p class.u_goods_txt').eq(0).text()")就是我加上去的，麻烦你看看哪儿出错了谢谢你，范老师。

谢礼军 · 发表于 2018-8-16 19:54

本帖最后由谢礼军于 2018-8-16 20:28 编辑

fxl447098457 发表于 2018-8-8 11:41
可以看看。。

结果如下：

<p>
Sub gedata()
Dim ie As Object, http As Object, dom As Object, win As Object, strtext As String
Dim url As String, arr, i&, k&, brr(), stock As String
Set http = CreateObject("msxml2.xmlhttp")
Set dom = CreateObject("htmlfile")
Set win = dom.parentwindow
UserName = "cqgytyy"
Password = "123456"
With http
.Open "post", "<a >http://fdm.yyjzt.com/user/topLogin.json</a>", False
.setrequestheader "content-type", "application/x-www-form-urlencoded;charset=UTF-8"
.send "jzt_username=" & UserName & "&jzt_password=" & Password
dom.write "<script src=""<a href='http://ajax.microsoft.com/ajax/jquery/jquery-1.4.min.js""></script><body></body'>http://ajax.microsoft.com/ajax/jquery/jquery-1.4.min.js""></script><body></body</a>>"
For Page = 1 To 2 '抓取2页
url = "<a >http://fdm.yyjzt.com/search/merchandise.htm?keyword&category&page</a>=" & Page
.Open "GET", url, False
.send
Do
DoEvents
Loop Until .Status = 200
arr = Split(.responsetext, "<table")
For i = 1 To UBound(arr)
dom.body.innerhtml = "<table>" & Split(arr(i), "</table>")(0) & "</table>"
k = k + 1: ReDim Preserve brr(1 To 7, 1 To k)
brr(1, k) = win.eval("$('a').contents().filter(function(){return this.nodeType==3;}).text()")
brr(2, k) = win.eval("$('td a span.u_goods_spec').eq(0).text()")
brr(3, k) = win.eval("$('td p.u_goods_com').eq(0).text()")
brr(4, k) = win.eval("$('td span.u_goods_pric').eq(0).text()")
brr(5, k) = win.eval("$('td p span.m_tag_kw').eq(1).text()")
stock = Split(Split(arr(i - 1), "u_goods_txt"">")(1), "<")(0)
brr(6, k) = re(stock)
brr(7, k) = win.eval("$('td p.u_goods_exp_start').eq(0).text()")
Next
Application.Wait (Now + TimeValue("0:00:05")) '休息5秒
Next
[a1:g1] = [{"药品名称","规格","厂家","销售价格","件装","库存","效期"}]
[a2].Resize(k, 7) = Application.Transpose(brr)
[a:g].EntireColumn.AutoFit
End With
End Sub</p><p>Function re(str)
With CreateObject("vbscript.regexp")
.Pattern = "\s+"
.Global = True
re = .Replace(str, "")
End With
End Function</p><p> </p><p>
</p>

复制代码

范老师你好，领导又说要抓取有效期，我照你的代码，在网页的源代码找到语句，增加上去，可能哪儿出错了，请范老师帮我看看。谢谢了

fxl447098457 · 发表于 2018-8-16 20:39

谢礼军发表于 2018-8-16 19:31
Sub gedata()
Dim ie As Object, http As Object, dom As Object, win As Object, strtext As String ...

brr(7, k) = Split(win.eval("$('td p.m_goods_des').eq(3).text()"), "：")(1)
因为有近远有效期两个，我都弄进来了。

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

[求助] 求助！求助 vba从网页中提取数据