不懂html也来学网抓（xmlhttp/winhttp+fiddler）

caipiaofans

老师好....

我自己尝试 最简单 的 站点..



Sub Main()
    Dim strText As String
    With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://trend.caipiao.163.com/11xuan5/?periodNumber=50", False
'       .setRequestHeader "Content-Type", "text/html; charset=UTF-8" 不用这句,能抓数据,但立即窗口显示很少数据,,,用了这句后 比之前的数据多了些.但还是显示不全啊...这个有问题吗???
'        .setRequestHeader "Referer", ""
        .Send
        strText = .responsetext
        Debug.Print strText
    End With
End Sub

caipiaofans

没装NET ,就找了个 fiddler2的抓包

VBA万岁

wcymiss 发表于 2014-10-21 16:10
获取数据-直接获取-转码：

在15楼的例子中：

太感谢老师了，我用你的GBKEnCode函数，终于圆满解决了505楼的问题。代码如下：

1. Function GBKEnCode(strText)
   
2.     Dim i, s
   
3.     For i = 1 To Len(strText)
   
4.         s = Hex(Asc(Mid(strText, i, 1)))
   
5.         If Len(s) = 4 Then s = Left(s, 2) & "%" & Right(s, 2)
   
6.         GBKEnCode = GBKEnCode & "%" & s
   
7.     Next
   
8. End Function
   
9. 
   
10. Sub test2()
    
11.     MsgBox Replace(GBKEnCode("HTTP://www.apabi.com/ValidateCode.aspx"), "%", "\u00")
    
12. End Sub
    

复制代码

若网址字符串中含有汉字，也可通过以上代码转换为unicode码（即含有“u\”的代码）。

wcymiss

xfyanmeng 发表于 2014-11-19 17:38
老师好，想请教一下，json数组如果key值不确定怎么处理？我要程序循环处理！
比如你这个第一次循环是 {" ...

检查下你系统文件夹里有没有这个文件：
TLBINF32.DLL
没有的话网上下载一个注册下。

然后测试下面的代码。

1. Sub Test()
   
2.     Const strJSON As String = "[{""name1"":""甲儿"",""age1"":10},{""name2"":""甲女"",""age2"":7}]"
   
3.     Dim objJSON As Object
   
4.     Dim Child
   
5.     Dim i As Long, j As Long
   
6.     Dim objTLI As Object
   
7.     Dim objMem As Object
   
8.    
   
9.     Set objTLI = CreateObject("tli.TLIApplication")
   
10.    
    
11.     With CreateObject("msscriptcontrol.scriptcontrol")
    
12.         .Language = "JavaScript"
    
13.         .AddCode "var mydata =" & strJSON
    
14.         Set objJSON = .CodeObject
    
15.     End With
    
16.    
    
17.     Cells.Clear
    
18.     For Each Child In CallByName(objJSON, "mydata", VbGet)
    
19.         i = i + 1
    
20.         j = 0
    
21.         For Each objMem In objTLI.InterfaceInfoFromObject(Child).Members
    
22.             j = j + 1
    
23.             Cells(i, j) = CallByName(Child, objMem.Name, VbGet)
    
24.         Next
    
25.     Next
    
26.    
    
27.     Set Child = Nothing
    
28.     Set objJSON = Nothing
    
29.     Set objMem = Nothing
    
30.     Set objTLI = Nothing
    
31. End Sub

复制代码

其实我很少这样取处理json数据。一般我都是用js语句处理好后再拿到vba里调用。

caipiaofans

要是 能有一个 详细的 网抓 数据处理,, 如何提取字符串,关键提取 等 代码讲解 就好了.

VBA万岁

VBA万岁 发表于 2014-11-20 11:20
太感谢老师了，我用你的GBKEnCode函数，终于圆满解决了505楼的问题。代码如下：若网址字符串中含有汉字， ...

在论坛上搜索良久，都没发现用VBA获取字符ASCII码的函数，于是，利用本帖20楼的GBKEnCode函数及以下帖子：
http://club.excelhome.net/thread-151294-2-1.html
14楼的代码，拼凑了一个用VBA获取字符ASCII码的函数，代码如下：

1. Function GBKEnCode(strText)
   
2. Dim i, s
   
3. For i = 1 To Len(strText)
   
4. s = Hex(Asc(Mid(strText, i, 1)))
   
5. If Len(s) = 4 Then s = Left(s, 2) & "%" & Right(s, 2)
   
6. GBKEnCode = GBKEnCode & "%" & s
   
7. Next
   
8. End Function
   
9. 
   
10. Function 十六转十(a)
    
11. Dim xi As Long
    
12. Dim x As Long
    
13. x = 0
    
14. For i = Len(a) To 1 Step -1
    
15. y = Mid(a, i, 1)
    
16. If y = "a" Then xi = 10
    
17. If y = "b" Then xi = 11
    
18. If y = "c" Then xi = 12
    
19. If y = "d" Then xi = 13
    
20. If y = "e" Then xi = 14
    
21. If y = "f" Then xi = 15
    
22. If y = 0 Then xi = 0
    
23. If y = 1 Then xi = 1
    
24. If y = 2 Then xi = 2
    
25. If y = 3 Then xi = 3
    
26. If y = 4 Then xi = 4
    
27. If y = 5 Then xi = 5
    
28. If y = 6 Then xi = 6
    
29. If y = 7 Then xi = 7
    
30. If y = 8 Then xi = 8
    
31. If y = 9 Then xi = 9
    
32. x = x + xi * (16 ^ (Len(a) - i))
    
33. Next i
    
34. 十六转十 = x
    
35. End Function
    
36. 
    
37. Function getASCII(str)
    
38. getASCII = 十六转十(Replace(GBKEnCode(str), "%", ""))
    
39. End Function
    
40. 
    
41. Sub 获取字符的ASCII码()
    
42. MsgBox getASCII(ActiveCell)
    
43. End Sub
    

复制代码

VBA万岁

VBA万岁 发表于 2014-11-20 12:12
在论坛上搜索良久，都没发现用VBA获取字符ASCII码的函数，于是，利用本帖20楼的GBKEnCode函数及以下帖子： ...

回头再看20楼代码，突然发现原来Asc函数就是将字符转换为ASCII码的函数。
汗颜！......

本人五笔输入

onlycxb 发表于 2014-10-22 08:25
作业2、网站：http://www.caac.gov.cn/S1/GNCX/，     操作：点击“查询”，获取航班信息数据。'顺便把航 ...

CreateObject("Adodb.Stream")

大哥，请问这代码的前提是不是还有安装什么才能运行啊？为什么说应用程序定义或对象定义错误啊？？？请解答啊。。。

VBA万岁

VBA万岁 发表于 2014-11-20 12:52
回头再看20楼代码，突然发现原来Asc函数就是将字符转换为ASCII码的函数。
汗颜！......

另，十六进制转十进制的工作表函数Hex2Dec测试如下：
Sub 十六进制转十进制()
    MsgBox Application.Hex2Dec(ActiveCell)
End Sub

不知是否还有十六进制转十进制的VBA函数，请吴姐指点！

VBA万岁

wcymiss 发表于 2014-10-21 16:10
获取数据-直接获取-转码：

在15楼的例子中：

参照老师的GBKEnCode函数，再写一个将字符转换为unicode码（含有“\u”的编码）的函数。

1. Function URLencode(strASCII As String) As String
   
2. Dim i, s
   
3. For i = 1 To Len(strASCII)
   
4.     s = Hex(Asc(Mid(strASCII, i, 1)))
   
5.     s =IIf(Len(s) = 4, "", "00") & s
   
6.     URLencode = URLencode & "\u" & s
   
7. Next
   
8. End Function
   
9. 
   
10. Sub test()
    
11.     MsgBox URLencode(ActiveCell)
    
12. End Sub
    

复制代码