Question

我有一个VBA脚本，可以在web上找到一些数据（csfd.cz）并放入Excel。但它很慢，因为加载网站（在IE中）然后提取数据需要一些时间。我的想法是如何使IE只加载HTML，它不加载任何图形和功能的东西 - 只有纯HTML。它有可能吗？谢谢你的帮助...

这是我的代码：

Sub InputData()
Dim cursor As String
Dim i As Long
Dim ie As Object
Dim lastRow As Long
Dim releasesLength As Long
Dim releases As Object
Dim oneRelease As Object
Dim datumKino As String
Dim datumDVD As String
Dim origins As String
Dim year As Long
Dim time As Long
Dim name As String
Dim genreLong As String
Dim genre As String

'zapamatování kurzoru
cursor = ActiveCell.Address

'zjištění posledního řádku
With ActiveSheet
    lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
End With

'první viditelná buňka
Range("L2").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.Height <> 0
    ActiveCell.Offset(1, 0).Select
Loop

'inicializace
Set ie = CreateObject("InternetExplorer.Application")

'ZAČÁTEK SMYČKY--------------------------------------------------------------
For i = ActiveCell.Row To lastRow
Cells(i, 12).Select

'resetování proměných
releasesLength = vbNullLong
Set releases = Nothing
Set oneRelease = Nothing
datumKino = ""
datumDVD = ""
origins = ""
year = vbNullLong
time = vbNullLong
name = ""
genreLong = ""
genre = ""

'vyřazení
If (InStr(Cells(i, 12).Value, "csfd.cz") = 0 Or ActiveCell.Height = 0) Then
GoTo NextRow
End If

'otevření stránky
ie.Visible = False
ie.navigate Cells(i, 12).Value
Application.StatusBar = "Načítám údaje. Prosím počkejte..."
Do While ie.busy
Application.Wait DateAdd("s", 1, Now)
Loop

'úprava procent a datumů

Cells(i, 9).Value = ie.document.getElementById("rating").Children(0).innerText
releasesLength = ie.document.getElementById("releases").getElementsByClassName("content")(0).getElementsByTagName("table")(0).getElementsByTagName("tbody")(0).Children.Length
Set releases = ie.document.getElementById("releases").getElementsByClassName("content")(0).getElementsByTagName("table")(0).getElementsByTagName("tbody")(0).Children
For j = 0 To releasesLength - 1
    Set oneRelease = releases(j)
    If (oneRelease.getElementsByTagName("th")(0).getElementsByTagName("img")(0).getAttribute("title") = "Česko") Then
        If (InStr(oneRelease.getElementsByTagName("th")(0).innerHTML, "V kinech")) Then
            If (datumKino = "") Then
                datumKino = Left(Replace(Replace(Replace(oneRelease.getElementsByTagName("td")(0).innerHTML, " ", ""), vbLf, ""), vbTab, ""), 10)
            End If
        ElseIf (InStr(oneRelease.getElementsByTagName("th")(0).innerHTML, "Na DVD")) Then
            If (datumDVD = "") Then
                datumDVD = Left(Replace(Replace(Replace(oneRelease.getElementsByTagName("td")(0).innerHTML, " ", ""), vbLf, ""), vbTab, ""), 10)
            End If
        ElseIf (InStr(oneRelease.getElementsByTagName("th")(0).innerHTML, "Na Blu-ray")) Then
            If (datumDVD = "") Then
                datumDVD = Left(Replace(Replace(Replace(oneRelease.getElementsByTagName("td")(0).innerHTML, " ", ""), vbLf, ""), vbTab, ""), 10)
            End If
        End If
    Else
        GoTo NextRelease
    End If
NextRelease:
Next j
If (Len(datumKino) <> 0) Then
Cells(i, 1).Value = datumKino
End If
If (Len(datumDVD) <> 0) Then
Cells(i, 2).Value = datumDVD
End If

'1. první zápis do řádku
If (Cells(i, 4).Value = "") Then
    year = ie.document.getElementsByClassName("origin")(0).getElementsByTagName("span")(0).innerHTML
    Cells(i, 4).Value = year

    origin = ie.document.getElementsByClassName("origin")(0).innerHTML
    originSplit = Split(origin, ",")
    time = Replace(originSplit(UBound(originSplit)), " min", "")
    Cells(i, 10).Value = time

    name = Replace(Replace(ie.document.getElementsByClassName("info")(0).getElementsByClassName("header")(0).getElementsByTagName("h1")(0).innerHTML, vbLf, ""), vbTab, "")
    Cells(i, 3).Value = name

    genreLong = ie.document.getElementsByClassName("genre")(0).innerHTML
    genre = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(genreLong, " ", ""), "Akční", "Akč."), "Animovaný", "Anim."), "Dobrodružný", "Dobr."), "Dokumentární", "Dokument."), "Fantasy", "Fant."), "Historický", "Histor."), "Katastrofický", "Katastrof."), "Komedie", "Kom."), "Mysteriózní", "Myster."), "Rodinný", "Rod."), "Romantický", "Romant."), "Thriller", "Thril."), "Životopisný", "Životopis.")
    Cells(i, 5).Value = genre
End If


NextRow:
Next i
'KONEC SMYČKY----------------------------------------------------------------

'Clean
ie.Quit
Set ie = Nothing
Set releases = Nothing
Set oneRelease = Nothing
Application.StatusBar = ""

Range(cursor).Select
End Sub

仅加载没有任何样式和脚本的HTML

0 个答案: