楼主
xmyjk |
Q:如何运用VBA获取网页上各理财产品的对比情况？网址：
A:- Option Explicit
- Private Declare Sub DeleteUrlCacheEntry Lib "wininet.dll" (ByVal lpszUrlName As String)
- Sub CommandButton1_Click()
- Dim Xmlhttp As Object, Adodb As Object
- Sheets(1).Image1.Picture = LoadPicture("")
- If Dir(ThisWorkbook.Path & "\" & "1" & ".jpg") <> "" Then Kill (ThisWorkbook.Path & "\" & "1" & ".jpg")
- Dim Strlcx As String, Strbjx As String, Strqijian As String
- Dim Lcx As String, Bjx As String, Qijian As String
- Strlcx = Trim(Range("c25").Value)
- Strbjx = Trim(Range("f25").Value)
- Strqijian = Trim(Range("c27").Value)
- Select Case Strlcx
- Case "e理财投连B款"
- Lcx = "118201"
- Case "积极成长型账户"
- Lcx = "506003"
- Case "稳健收益型账户"
- Lcx = "506001"
- End Select
- Select Case Strbjx
- Case "上证指数"
- Bjx = "SZ"
- Case "上证180"
- Bjx = "ZS000010"
- Case "上证50"
- Bjx = "ZS000016"
- Case "上证基金指数"
- Bjx = "ZS000011"
- Case "国债指数"
- Bjx = "ZS000012"
- Case "沪深300"
- Bjx = "ZS000300"
- Case "中债指数"
- Bjx = "ZZ"
- Case "中小板指"
- Bjx = "ZS399005"
- Case "深证成指"
- Bjx = "ZS399001"
- Case "深证综指"
- Bjx = "ZS399106"
- Case "深证基金指数"
- Bjx = "ZS399305"
- Case "银华核心价值优选基金"
- Bjx = "519001"
- Case "华夏大盘精选基金"
- Bjx = "000011"
- Case "华夏复兴基金"
- Bjx = "000031"
- Case "华夏成长基金"
- Bjx = "000001"
- Case "交银成长基金"
- Bjx = "519692"
- Case "银华领先策略基金"
- Bjx = "180013"
- End Select
- Select Case Strqijian
- Case "10天"
- Qijian = "10"
- Case "30天"
- Qijian = "30"
- Case "90天"
- Qijian = "90"
- Case "180天"
- Qijian = "180"
- Case "1年"
- Qijian = "1"
- Case "3年"
- Qijian = "3"
- End Select
- Dim Url As String
- Url = "http://mall.taikang.com/elicai/image.jsp?accountid=" & Lcx & "&fundcode=" & Bjx & "&period=" & Qijian
- Set Xmlhttp = CreateObject("Microsoft.XMLHTTP")
- Xmlhttp.Open "get", Url, False
- Xmlhttp.setRequestHeader "Content-Type", "text/html"
- Xmlhttp.Send ""
- Do Until Xmlhttp.ReadyState = 4
- DoEvents
- Loop
- Set Xmlhttp = Nothing
- Set Xmlhttp = CreateObject("Microsoft.XMLHTTP")
- Xmlhttp.Open "get", "http://mall.taikang.com/elicai/imageServlet", False
- Xmlhttp.setRequestHeader "Content-Type", "image/jpeg"
- Xmlhttp.Send ""
- Do Until Xmlhttp.ReadyState = 4
- DoEvents
- Loop
- If Xmlhttp.Status = 200 Then
- Set Adodb = CreateObject("ADODB.Stream")
- With Adodb
- .Type = 1
- .Open
- .write Xmlhttp.Responsebody
- .savetofile ThisWorkbook.Path & "\" & "1" & ".jpg", 2 '另存图片
- .Close
- End With
- Sheets(1).Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & "1" & ".jpg")
- Else
- reportErr (Xmlhttp.Status)
- End If
- Set Xmlhttp = Nothing
- Set Adodb = Nothing
- DeleteUrlCacheEntry "http://mall.taikang.com/elicai/imageServlet"
- If Dir(ThisWorkbook.Path & "\" & "1" & ".jpg") <> "" Then Kill (ThisWorkbook.Path & "\" & "1" & ".jpg")
- MsgBox "查询并加载图片成功！"
- End Sub
- Sub reportErr(lStatus As Integer)
- Select Case lStatus
- Case 400
- MsgBox "Bad Request", vbCritical, "连接错误"
- Case 401
- MsgBox "Unauthorized", vbCritical, "连接错误"
- Case 402
- MsgBox "Payment Required", vbCritical, "连接错误"
- Case 403
- MsgBox "Forbidden", vbCritical, "连接错误"
- Case 404
- MsgBox "Not Found", vbCritical, "连接错误"
- Case 407
- MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
- Case 408
- MsgBox "Request Timeout", vbCritical, "连接错误"
- Case 503
- MsgBox "Service Unavailable", vbCritical, "连接错误"
- Case Else
- MsgBox "Can not reach by other reason", vbCritical, "连接错误"
- End Select
- End Sub
 账户对比.rar
|