☰

VBA 代码因语法错误而无法运行

tag-icon • tag-icon microsoft-excel vba
VBA 代码因语法错误而无法运行

我是 VBA 新手。我的目标是创建一个函数，根据 URL 显示 Steam 商品的最低价格。

这是我目前整理的混搭代码。但是，似乎存在语法错误的问题。

示例 URL 为 http://steamcommunity.com/market/listings/440/Genuine%20Ap-Sap

我想获取页面上的最低价格，并将其显示在单元格中。页面的 HTML 如下所示。我希望它检索最低价格，目前最低价格为 9.89。我希望它显示带费用的市场标价。

 <span class="market_listing_price market_listing_price_with_fee">
                    S&#36;9.89              </span>
                <span class="market_listing_price market_listing_price_without_fee">
                    S&#36;8.60              </span>

我的 VBA 代码如下（存在一些语法错误）

Sub Retrieveprice() ' in the references section, enable 1) Microsoft Internet Controls, and 2) Microsoft HTML Object Library

Dim x As Long, y As Long Dim htmlText As Object

Set htmlText = CreateObject("htmlFile")

With CreateObject("msxml2.xmlhttp")
    .Open "GET", steamurl, False    ' save the URL in name manager as steamurl
    ' an example URL would be http://steamcommunity.com/market/listings/440/Genuine%20Ap-Sap
    .send
    htmlText.body.innerHTML = .responsetext End With

lStartPos = InStr(1, .responsetext, "<span class=CHR(34)market_listing_price market_listing_price_with_feeCHR(34)"> ") 
lEndPos = lStartPos + 12   'haven't counted the exact number yet, want to retrieve price
TextIWant = Mid$(.responsetext, lStartPos, lEndPos - lStartPos)   

Workbook.Worksheets.Add 
ActiveSheet.Range("A1").Value = TextIWant  

End Sub

最终，如果我能解决这个问题，我想把它变成一个函数，这样我就可以让一个单元格说 =Retrieveprice(URL)，它会返回 URL 上 Steam 物品的最低价格。

有人能告诉我如何修复此代码并将其转换为函数吗？我将不胜感激。

答案1

通常，.responseText会将 解析为HTML文档，但也可以使用字符串函数来处理。您似乎对Mid、Instr等很满意，所以我坚持使用这种方法。这不会启动新的工作表；只会写入当前工作表，因此请在运行宏之前从新的空白工作表开始。

Sub Retrieveprice() ' in the references section, enable 1) Microsoft Internet Controls, and 2) Microsoft HTML Object Library

    Dim x As Long, y As Long, steamUrl As String, steamTxt As String, spanTxt As String, spanEndTxt As String

    steamUrl = "http://steamcommunity.com/market/listings/440/Genuine%20Ap-Sap"

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", steamUrl, False
        .send
        steamTxt = .responsetext
    End With

    spanTxt = "<span class=""market_listing_price market_listing_price_with_fee"">"
    spanEndTxt = "</span>"
    x = InStr(1, steamTxt, spanTxt)
    With ActiveSheet
        Do While CBool(x)
            y = InStr(x, steamTxt, spanEndTxt)
            .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = _
              Application.Trim(Replace(Mid(steamTxt, x, (y - x) + Len(spanEndTxt)), Chr(10), vbNullString))
            x = InStr(y, steamTxt, spanTxt)
        Loop
    End With

End Sub

您可以期待类似以下的结果。

           msxml2.xmlhttp 获取

根据您提供的信息我只能提供这么多，但它应该能为您指明正确的方向。

相关内容