请各位老师帮忙做个网页查询

puresway

各位朋友，晚安!

xmyjk

安，打算回去休息了，明天再奋斗

puresway

顶一下！

puresway

再次顶一下！

puresway

哪位老师能帮小弟写一下，xmyjk前辈已经把主要的代码写好了，哪位老师帮忙做一下，小弟对网页操作一窍不通

puresway

顶一下，望各位老师帮助！谢谢

xmyjk

勉强搞定
不过有个问题，
打开excel，首次进行查询，能得到结果图片，后续继续查询图片就不会更新了。
然后，必须要关闭excel，再重新打开才能对新的查询返回正确的图片
初步预计和缓存有关系，希望其他高手帮忙看看
代码如下，excel见附件

1. Option Explicit
   
2. Sub CommandButton1_Click()
   
3. 
   
4. Dim Xmlhttp As Object, Adodb As Object
   
5. 
   
6. Sheets(1).Image1.Picture = LoadPicture("")
   
7. If Dir(ThisWorkbook.Path & "" & "1" & ".jpg") <> "" Then Kill (ThisWorkbook.Path & "" & "1" & ".jpg")
   
8. 
   
9. Dim Strlcx As String, Strbjx As String, Strqijian As String
   
10. Dim Lcx As String, Bjx As String, Qijian As String
    
11. 
    
12. Strlcx = Trim(Range("c25").Value)
    
13. Strbjx = Trim(Range("f25").Value)
    
14. Strqijian = Trim(Range("c27").Value)
    
15. 
    
16. Select Case Strlcx
    
17.    Case "e理财投连B款"
    
18.      Lcx = "118201"
    
19.    Case "积极成长型账户"
    
20.      Lcx = "506003"
    
21.    Case "稳健收益型账户"
    
22.      Lcx = "506001"
    
23. End Select
    
24. 
    
25. Select Case Strbjx
    
26.    Case "上证指数"
    
27.      Bjx = "SZ"
    
28.    Case "上证180"
    
29.      Bjx = "ZS000010"
    
30.    Case "上证50"
    
31.      Bjx = "ZS000016"
    
32.    Case "上证基金指数"
    
33.      Bjx = "ZS000011"
    
34.    Case "国债指数"
    
35.      Bjx = "ZS000012"
    
36.    Case "沪深300"
    
37.      Bjx = "ZS000300"
    
38.    Case "中债指数"
    
39.      Bjx = "ZZ"
    
40.    Case "中小板指"
    
41.      Bjx = "ZS399005"
    
42.    Case "深证成指"
    
43.      Bjx = "ZS399001"
    
44.    Case "深证综指"
    
45.      Bjx = "ZS399106"
    
46.    Case "深证基金指数"
    
47.      Bjx = "ZS399305"
    
48.    Case "银华核心价值优选基金"
    
49.      Bjx = "519001"
    
50.    Case "华夏大盘精选基金"
    
51.      Bjx = "000011"
    
52.    Case "华夏复兴基金"
    
53.      Bjx = "000031"
    
54.    Case "华夏成长基金"
    
55.      Bjx = "000001"
    
56.    Case "交银成长基金"
    
57.      Bjx = "519692"
    
58.    Case "银华领先策略基金"
    
59.      Bjx = "180013"
    
60. End Select
    
61. 
    
62. Select Case Strqijian
    
63.    Case "10天"
    
64.      Qijian = "10"
    
65.    Case "30天"
    
66.      Qijian = "30"
    
67.    Case "90天"
    
68.      Qijian = "90"
    
69.    Case "180天"
    
70.      Qijian = "180"
    
71.     Case "1年"
    
72.      Qijian = "1"
    
73.     Case "3年"
    
74.      Qijian = "3"
    
75. End Select
    
76. 
    
77. Dim Url As String
    
78. Url = "http://mall.taikang.com/elicai/image.jsp?accountid=" & Lcx & "&fundcode=" & Bjx & "&period=" & Qijian
    
79. 
    
80. Set Xmlhttp = CreateObject("Microsoft.XMLHTTP")
    
81. Xmlhttp.Open "get", Url, False
    
82. Xmlhttp.setRequestHeader "Content-Type", "text/html"
    
83. Xmlhttp.Send ""
    
84. Do Until Xmlhttp.ReadyState = 4
    
85. DoEvents
    
86. Loop
    
87. 
    
88. Set Xmlhttp = Nothing
    
89. 
    
90. Set Xmlhttp = CreateObject("Microsoft.XMLHTTP")
    
91. Xmlhttp.Open "get", "http://mall.taikang.com/elicai/imageServlet", False
    
92. Xmlhttp.setRequestHeader "Content-Type", "image/jpeg"
    
93. Xmlhttp.Send ""
    
94. Do Until Xmlhttp.ReadyState = 4
    
95. DoEvents
    
96. Loop
    
97. 
    
98. If Xmlhttp.Status = 200 Then
    
99. 
    
100. Set Adodb = CreateObject("ADODB.Stream")
     
101.    With Adodb
     
102.             .Type = 1
     
103.             .Open
     
104.             .write Xmlhttp.Responsebody
     
105.             .savetofile ThisWorkbook.Path & "" & "1" & ".jpg", 2   '另存图片
     
106.             .Close
     
107. End With
     
108. Sheets(1).Image1.Picture = LoadPicture(ThisWorkbook.Path & "" & "1" & ".jpg")
     
109. 
     
110. Else
     
111.   reportErr (Xmlhttp.Status)
     
112. End If
     
113. 
     
114. Set Xmlhttp = Nothing
     
115. Set Adodb = Nothing
     
116. If Dir(ThisWorkbook.Path & "" & "1" & ".jpg") <> "" Then Kill (ThisWorkbook.Path & "" & "1" & ".jpg")
     
117. 
     
118. MsgBox "查询并加载图片成功！"
     
119. 
     
120. 
     
121. End Sub
     
122. 
     
123. Sub reportErr(lStatus As Integer)
     
124.         Select Case lStatus
     
125.             Case 400
     
126.                 MsgBox "Bad Request", vbCritical, "连接错误"
     
127.             Case 401
     
128.                 MsgBox "Unauthorized", vbCritical, "连接错误"
     
129.             Case 402
     
130.                 MsgBox "Payment Required", vbCritical, "连接错误"
     
131.             Case 403
     
132.                 MsgBox "Forbidden", vbCritical, "连接错误"
     
133.             Case 404
     
134.                 MsgBox "Not Found", vbCritical, "连接错误"
     
135.             Case 407
     
136.               MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
     
137.             Case 408
     
138.                 MsgBox "Request Timeout", vbCritical, "连接错误"
     
139.             Case 503
     
140.                 MsgBox "Service Unavailable", vbCritical, "连接错误"
     
141.             Case Else
     
142.               MsgBox "Can not reach by other reason", vbCritical, "连接错误"
     
143.         End Select
     
144. 
     
145. End Sub

复制代码

[ 本帖最后由 xmyjk 于 2011-3-11 00:11 编辑 ]

xmyjk

谢谢ah2005的指导：
出现问题的最大原因你说对了，没有加上清除COOKIE，DeleteUrlCacheEntry URL

增加API 引用wininet.dll的DeleteUrlCacheEntry函数去清楚缓存
修正后的代码如下，excel见附件：

1. 
   
2. Option Explicit
   
3. 
   
4. Private Declare Sub DeleteUrlCacheEntry Lib "wininet.dll" (ByVal lpszUrlName As String)
   
5. 
   
6. 
   
7. Sub CommandButton1_Click()
   
8. 
   
9. Dim Xmlhttp As Object, Adodb As Object
   
10. 
    
11. Sheets(1).Image1.Picture = LoadPicture("")
    
12. If Dir(ThisWorkbook.Path & "" & "1" & ".jpg") <> "" Then Kill (ThisWorkbook.Path & "" & "1" & ".jpg")
    
13. 
    
14. Dim Strlcx As String, Strbjx As String, Strqijian As String
    
15. Dim Lcx As String, Bjx As String, Qijian As String
    
16. 
    
17. Strlcx = Trim(Range("c25").Value)
    
18. Strbjx = Trim(Range("f25").Value)
    
19. Strqijian = Trim(Range("c27").Value)
    
20. 
    
21. Select Case Strlcx
    
22.    Case "e理财投连B款"
    
23.      Lcx = "118201"
    
24.    Case "积极成长型账户"
    
25.      Lcx = "506003"
    
26.    Case "稳健收益型账户"
    
27.      Lcx = "506001"
    
28. End Select
    
29. 
    
30. Select Case Strbjx
    
31.    Case "上证指数"
    
32.      Bjx = "SZ"
    
33.    Case "上证180"
    
34.      Bjx = "ZS000010"
    
35.    Case "上证50"
    
36.      Bjx = "ZS000016"
    
37.    Case "上证基金指数"
    
38.      Bjx = "ZS000011"
    
39.    Case "国债指数"
    
40.      Bjx = "ZS000012"
    
41.    Case "沪深300"
    
42.      Bjx = "ZS000300"
    
43.    Case "中债指数"
    
44.      Bjx = "ZZ"
    
45.    Case "中小板指"
    
46.      Bjx = "ZS399005"
    
47.    Case "深证成指"
    
48.      Bjx = "ZS399001"
    
49.    Case "深证综指"
    
50.      Bjx = "ZS399106"
    
51.    Case "深证基金指数"
    
52.      Bjx = "ZS399305"
    
53.    Case "银华核心价值优选基金"
    
54.      Bjx = "519001"
    
55.    Case "华夏大盘精选基金"
    
56.      Bjx = "000011"
    
57.    Case "华夏复兴基金"
    
58.      Bjx = "000031"
    
59.    Case "华夏成长基金"
    
60.      Bjx = "000001"
    
61.    Case "交银成长基金"
    
62.      Bjx = "519692"
    
63.    Case "银华领先策略基金"
    
64.      Bjx = "180013"
    
65. End Select
    
66. 
    
67. Select Case Strqijian
    
68.    Case "10天"
    
69.      Qijian = "10"
    
70.    Case "30天"
    
71.      Qijian = "30"
    
72.    Case "90天"
    
73.      Qijian = "90"
    
74.    Case "180天"
    
75.      Qijian = "180"
    
76.     Case "1年"
    
77.      Qijian = "1"
    
78.     Case "3年"
    
79.      Qijian = "3"
    
80. End Select
    
81. 
    
82. Dim Url As String
    
83. Url = "http://mall.taikang.com/elicai/image.jsp?accountid=" & Lcx & "&fundcode=" & Bjx & "&period=" & Qijian
    
84. 
    
85. Set Xmlhttp = CreateObject("Microsoft.XMLHTTP")
    
86. Xmlhttp.Open "get", Url, False
    
87. Xmlhttp.setRequestHeader "Content-Type", "text/html"
    
88. Xmlhttp.Send ""
    
89. Do Until Xmlhttp.ReadyState = 4
    
90. DoEvents
    
91. Loop
    
92. 
    
93. Set Xmlhttp = Nothing
    
94. 
    
95. Set Xmlhttp = CreateObject("Microsoft.XMLHTTP")
    
96. Xmlhttp.Open "get", "http://mall.taikang.com/elicai/imageServlet", False
    
97. Xmlhttp.setRequestHeader "Content-Type", "image/jpeg"
    
98. Xmlhttp.Send ""
    
99. Do Until Xmlhttp.ReadyState = 4
    
100. DoEvents
     
101. Loop
     
102. 
     
103. If Xmlhttp.Status = 200 Then
     
104. 
     
105. Set Adodb = CreateObject("ADODB.Stream")
     
106.    With Adodb
     
107.             .Type = 1
     
108.             .Open
     
109.             .write Xmlhttp.Responsebody
     
110.             .savetofile ThisWorkbook.Path & "" & "1" & ".jpg", 2   '另存图片
     
111.             .Close
     
112. End With
     
113. Sheets(1).Image1.Picture = LoadPicture(ThisWorkbook.Path & "" & "1" & ".jpg")
     
114. 
     
115. Else
     
116.   reportErr (Xmlhttp.Status)
     
117. End If
     
118. 
     
119. Set Xmlhttp = Nothing
     
120. Set Adodb = Nothing
     
121. 
     
122. 
     
123. DeleteUrlCacheEntry "http://mall.taikang.com/elicai/imageServlet"
     
124. 
     
125. If Dir(ThisWorkbook.Path & "" & "1" & ".jpg") <> "" Then Kill (ThisWorkbook.Path & "" & "1" & ".jpg")
     
126. 
     
127. MsgBox "查询并加载图片成功！"
     
128. 
     
129. 
     
130. End Sub
     
131. 
     
132. Sub reportErr(lStatus As Integer)
     
133.         Select Case lStatus
     
134.             Case 400
     
135.                 MsgBox "Bad Request", vbCritical, "连接错误"
     
136.             Case 401
     
137.                 MsgBox "Unauthorized", vbCritical, "连接错误"
     
138.             Case 402
     
139.                 MsgBox "Payment Required", vbCritical, "连接错误"
     
140.             Case 403
     
141.                 MsgBox "Forbidden", vbCritical, "连接错误"
     
142.             Case 404
     
143.                 MsgBox "Not Found", vbCritical, "连接错误"
     
144.             Case 407
     
145.               MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
     
146.             Case 408
     
147.                 MsgBox "Request Timeout", vbCritical, "连接错误"
     
148.             Case 503
     
149.                 MsgBox "Service Unavailable", vbCritical, "连接错误"
     
150.             Case Else
     
151.               MsgBox "Can not reach by other reason", vbCritical, "连接错误"
     
152.         End Select
     
153. 
     
154. End Sub
     

复制代码

ah2005

原帖由 xmyjk 于 2011-3-11 01:14 发表
谢谢ah2005的指导：
出现问题的最大原因你说对了，没有加上清除COOKIE，DeleteUrlCacheEntry URL

增加API 引用wininet.dll的DeleteUrlCacheEntry函数去清楚缓存
修正后的代码如下，excel见附件：
Option Expli ...

呵呵，最近在研究抓包。

120HYH

xmyjk 兄弟真是我的偶像啊。