2013-02-27 50 views
1

是它可以讀取從一個超鏈接的網頁,在Excel中,通過改變此VBA代碼直接計算從網頁的可讀性分數與符號和感嘆詞不查詢數據返回到Excel?也可以從文件路徑?這是全部在一個電子表格。計數數據是從URL

Option Compare Text 

Sub Display_Stylometric_Scores() 
    Dim Words As String 
    Dim Characters As String 
    Dim Paragraphs As String 
    Dim Sentences As String 
    Dim Sentences_per_paragraph As String 
    Dim Words_per_sentence As String 
    Dim Characters_per_word As String 
    Dim Ratio_of_passive_sentences As String 
    Dim Flesch_Reading_Ease_score As String 
    Dim Flesch_Kincaid_Grade_Level_score As String 
    Dim Coleman_Liau_Readability_Score As String 
    Dim Ampersands As Long 
    Dim Exclamations As Long 
    Dim row As Integer 
    Dim column As Integer 
    Dim ActiveDocument As Object 
    Dim RS As Object 
    Dim txt As String 

    row = 3 

    Set ActiveDocument = CreateObject("Word.Document") 

    Do While Worksheets("Sample_Output_2").Cells(row, 1) <> "" 

     txt = Worksheets("Sample_Output_2").Cells(row, 2).Value 
     ActiveDocument.Content = txt 

     Set RS = ActiveDocument.Content.ReadabilityStatistics 

     Words = RS(1).Value 
     Characters = RS(2).Value 
     Paragraphs = RS(3).Value 
     Sentences = RS(4).Value 
     Sentences_per_paragraph = RS(5).Value 
     Words_per_sentence = RS(6).Value 
     Characters_per_word = RS(7).Value 
     Ratio_of_passive_sentences = RS(8).Value 
     Flesch_Reading_Ease_score = RS(9).Value 
     Flesch_Kincaid_Grade_Level_score = RS(10).Value 
     Ampersands = CountChar(txt, "&") 
     Exclamations = CountChar(txt, "!") 

     Worksheets("Sample_Output_2").Cells(row, 4).Resize(1, 12).Value = 
      Array(Words, Characters, Paragraphs, Sentences, Sentences_per_paragraph, _    
       Words_per_sentence, Characters_per_word, Ratio_of_passive_sentences, _ 
       Flesch_Reading_Ease_score, Flesch_Kincaid_Grade_Level_score, _ 
       Ampersands, Exclamations) 

     row = row + 1 
    Loop 

End Sub 

Function CountChar(txt As String, char As String) As Long 
    CountChar = Len(txt) - Len(Replace(txt, char, "")) 
End Function 

回答

1

是的,你使用MXSML來發出http請求。下面是一個示例,並對現有代碼進行一些重構:

Sub Main() 

    Dim vaWrite As Variant 
    Dim hDoc As MSHTML.HTMLDocument 
    Dim xHttp As MSXML2.XMLHTTP 

    'Set a reference to MSXML2 
    'Open a webpage using GET 
    Set xHttp = New MSXML2.XMLHTTP 
    xHttp.Open "GET", "http://stackoverflow.com/questions/15103048/count-data-on-webpage-from-url-in-excel-vba" 
    xHttp.send 

    'Wait for the web page to finish loading 
    Do Until xHttp.readyState = 4 
     DoEvents 
    Loop 

    'If the web page rendered properly 
    If xHttp.Status = 200 Then 
     'Create a new HTMLdocument 
     Set hDoc = New MSHTML.HTMLDocument 
     'Put the GET response into the doc's body 
     hDoc.body.innerHTML = xHttp.responseText 

     'Get an array back containing the readability scores 
     vaWrite = Display_Stylometric_Scores(hDoc.body.innerText) 

     'Write that array to a worksheet 
     Sheet1.Range("A2").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite 
    End If 

End Sub 

Function Display_Stylometric_Scores(ByRef sText As String) As Variant 

    Dim aReadStats(1 To 1, 1 To 12) As Double 
    Dim wdDoc As Object 
    Dim wdRs As Object 
    Dim i As Long 
    Dim vaSpecial As Variant 

    Const lMAXIDX As Long = 10 

    vaSpecial = Array("&", "!") 

    Set wdDoc = CreateObject("Word.Document") 
    wdDoc.Content = sText 

    Set wdRs = wdDoc.Content.ReadabilityStatistics 

    For i = 1 To lMAXIDX 
     aReadStats(1, i) = wdRs(i).Value 
    Next i 

    For i = LBound(vaSpecial) To UBound(vaSpecial) 
     aReadStats(1, lMAXIDX + 1 + i) = CountChar(sText, vaSpecial(i)) 
    Next i 

    Display_Stylometric_Scores = aReadStats 

End Function 

Function CountChar(ByRef sText As String, ByVal sChar As String) As Long 
    CountChar = Len(sText) - Len(Replace(sText, sChar, vbNullString)) 
End Function 
+0

您還需要對MSHTML的引用。工具 - VBE中的引用,並查找Microsoft XML x.x和Microsoft HTML或類似內容。 – 2013-02-27 03:26:53

+0

謝謝。當我運行它時,出現此錯誤:運行時錯誤「4658」:ToolsGrammarStatisticsArray無法在包含多種語言格式的文檔上運行。這是什麼意思?我該如何解決它? – 2013-02-27 04:32:29

+0

網頁是否包含多種語言?它是否像你以前那樣工作?什麼網頁給你這個錯誤? – 2013-02-27 14:43:53