新手求助，网页地址以日期为变量抓数据,但抓到的都是同一天的,求高手指教

emollient

http://odds.500.com/bodan_jczq.shtml
网抓新手，想抓这个网站的数据   里面有个下拉框可以选择日期  选择后网址也会变化   想根据日期来抓数据插入到不同单元表，
但抓出来的数据都是同一天的  求高手指教是什么问题

1. Sub MainAll()
   
2.     Dim strText As String, strText1 As String, Dat As String, URL As String
   
3.     Dim arrDat
   
4.     Dim i As Long, j As Long, n As Long
   
5.     Dim arrData(1 To 7)
   
6.     Dim TR As Object, TD As Object
   
7.     Set MS = CreateObject("MSXML2.XMLHTTP")
   
8.     With MS
   
9.         .Open "GET", "http://odds.500.com/bodan_jczq.shtml", False
   
10.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
11.         .setRequestHeader "Referer", ""
    
12.         .Send
    
13. 
    
14.         strText = BytesToBstr(.responseBody, "GB2312")                     '因此要用Adodb.Stream对象
    
15.     End With
    
16.     arrDate = Split(strText, "</option>")
    
17.     For i = 0 To UBound(arrDate) - 1
    
18.         Dat = Right(arrDate(i), 10)
    
19.         URL = "http://odds.500.com/bodan_jczq_" & Dat & ".shtml"
    
20.         Debug.Print (URL)
    
21.         With MS
    
22.              .Open "GET", URL, False
    
23.              .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
24.              .setRequestHeader "Referer", ""
    
25.              .Send
    
26.              strText1 = BytesToBstr(.responseBody, "GB2312")                     '因此要用Adodb.Stream对象
    
27.         End With
    
28.         strText1 = "<table" & Split(Split(strText, "<table")(3), "</table>")(0) & "</table>"
    
29. 
    
30.         CopyToClipbox strText1
    
31.         Sheets.Add after:=Sheets(Sheets.Count - i)
    
32.         Sheets(Sheets.Count - i).Activate
    
33.         ActiveSheet.Name = Dat
    
34.         Cells.Clear
    
35.         Range("a1").Select
    
36.         ActiveSheet.Paste
    
37. 
    
38.     Next
    
39.       
    
40. End Sub
    
41. 
    
42. Sub CopyToClipbox(strText As String)
    
43.         '文本拷贝到剪贴板
    
44.     With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
45.          .SetText strText
    
46.          .PutInClipboard
    
47.     End With
    
48. End Sub
    
49. 
    
50. 
    
51. Function BytesToBstr(strBody, CodeBase)         '使用Adodb.Stream对象提取字符串
    
52.     Dim objStream
    
53.     On Error Resume Next
    
54.     Set objStream = CreateObject("Adodb.Stream")
    
55.     With objStream
    
56.         .Type = 1                               '二进制
    
57.         .Mode = 3                               '读写
    
58.         .Open
    
59.         .write strBody                          '二进制数组写入Adodb.Stream对象内部
    
60.         .Position = 0                           '位置起始为0
    
61.         .Type = 2                               '字符串
    
62.         .Charset = CodeBase                     '数据的编码格式
    
63.         BytesToBstr = .ReadText                 '得到字符串
    
64.     End With
    
65.     objStream.Close
    
66.     Set objStream = Nothing
    
67.     If Err.Number <> 0 Then BytesToBstr = ""
    
68.     On Error GoTo 0
    
69. End Function
    
70. 
    
71. 
    
72. 
    
73. 
    
74. 
    
75. 
    
76. 
    
77. 
    

复制代码

未忘初心

1. http://odds.500.com/bodan_jczq_2017-06-26.shtml

复制代码

抓这个地址

emollient

我是想抓一周的，结果抓出来都是当天的

emollient

未忘初心 发表于 2017-6-26 23:53
抓这个地址

我是想抓一周的，结果抓出来都是当天的

kldxlb

太马虎了你，strText1改成strText就好了
Sub MainAll()
    Dim strText As String, strText1 As String, Dat As String, URL As String
    Dim arrDat
    Dim i As Long, j As Long, n As Long
    Dim arrData(1 To 7)
    Dim TR As Object, TD As Object
    Set MS = CreateObject("MSXML2.XMLHTTP")
    With MS
        .Open "GET", "http://odds.500.com/bodan_jczq.shtml", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Referer", ""
        .Send

        strText = BytesToBstr(.responseBody, "GB2312")                     '因此要用Adodb.Stream对象
    End With
    arrDate = Split(strText, "</option>")
    For i = 0 To UBound(arrDate) - 1
        Dat = Right(arrDate(i), 10)
        URL = "http://odds.500.com/bodan_jczq_" & Dat & ".shtml"
        Debug.Print (URL)
        With MS
             .Open "GET", URL, False
             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
             .setRequestHeader "Referer", ""
             .Send
             strText = BytesToBstr(.responseBody, "GB2312")                     '因此要用Adodb.Stream对象
        End With
        strText1 = "<table" & Split(Split(strText, "<table")(3), "</table>")(0) & "</table>"

        CopyToClipbox strText1
        Sheets.Add after:=Sheets(Sheets.Count - i)
        Sheets(Sheets.Count - i).Activate
        ActiveSheet.Name = Dat
        Cells.Clear
        Range("a1").Select
        ActiveSheet.Paste

    Next

End Sub