O código VBA não está funcionando devido a um erro de sintaxe

1

Sou novo no VBA. Meu objetivo aqui é criar uma função para mostrar o menor preço de um item de vapor, dado um URL.

Aqui está o código mash-up que eu montei até agora. No entanto, parece haver um problema com um erro de sintaxe.

Um exemplo de URL é link

Eu quero que o menor preço da página seja exibido em uma célula. O HTML da página é assim. Eu quero recuperar o menor preço, atualmente é 9,89. Quero que mostre o preço de listagem do mercado com taxa.

 <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>

Meu código VBA segue (há algum erro de sincronia)

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

Eventualmente, se eu conseguir resolver isso, quero transformá-lo em uma função, para que eu possa ter uma célula dizendo = Retrieveprice (URL) e retornar o menor preço do item de vapor na URL.

Alguém pode me dizer como corrigir esse código e transformá-lo em uma função? Eu realmente aprecio isso.

    
por user13783 30.11.2014 / 11:06

1 resposta

0

Normalmente, o .responseText é analisado como um documento HTML , mas também pode ser manipulado com funções de string. Você parecia confortável com Mid , Instr , etc, então eu permaneci nesse caminho. Isso não inicia uma nova planilha; simplesmente escreve no atual, então comece com uma nova planilha em branco antes de executar a macro.

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

Você pode esperar resultados semelhantes aos seguintes.

Isso é o máximo que posso com as informações que você forneceu, mas isso deve dar um empurrãozinho na direção certa.

    
por 30.11.2014 / 12:39