Chcę pobrać plik Excel dołączony do html przez Excel vba i wyprowadzić go w arkuszu Excel. Ta strona główna zawiera listę aktualnego stanu kas, które były popularne w koreańskich kinach.

http://www.kobis.or.kr/kobis/business/stat/boxs/findFormerBoxOfficeList.do?loadEnd=0&searchType=search&sMultiMovieYn=&sRepNationCd=&sWideAreaCd=

Załączony plik to Excel. Rozumiem, że pobieranie można wykonać metodą kliknięcia poprzez wyszukiwanie w Internecie. Jednak podczas pobierania pliku pojawia się okno alertu, aw nazwie pliku Excel do pobrania wstawiana jest data. Jako początkujący w Excelu VBA jest to bardzo trudne. Zostawiłem więc to pytanie, a jaka logika byłaby przydatna, aby zaimplementować ten plik w arkuszu Excela? Jestem początkujący w Excel VBA, więc jeśli udzielisz mi szczegółowej odpowiedzi, będzie to bardzo pomocne.

<p class = "btn_regi">
<a href="#none" class="btn_type01" onclick="chkform('excel'); return false ;"> 
<strong> Excel </ strong> </a>
</ p>

Poniższą logikę zakodowałem sobie do świtu. Jednak logika była zbyt nieefektywna, a wyniki nie działały, więc poprosiłem o pomoc.

Sub program_()

        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual

        Dim bridge As String

        Dim WinHttp As New WinHttpRequest
        Dim sResponse As String, html As New HTMLDocument, hStructure As Object, hTable As HTMLTable

        Dim ws As Worksheet
        Set ws = ThisWorkbook.Worksheets("Sheet1")

        Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

        Dim Url As String
        Url = "http://www.kobis.or.kr/kobis/business/stat/boxs/findFormerBoxOfficeList.do?"

        Dim p1 As String 'parameter
        Dim v1 As String
        Dim p2 As String
        Dim v2 As String
        Dim p3 As String
        Dim v3 As String
        Dim p4 As String
        Dim v4 As String
        Dim p5 As String
        Dim v5 As String
        Dim v As Integer
        Dim g As Integer

        bridge = "&"
        p1 = "loadEnd="
        v1 = 0
        p2 = "searchType="
        v2 = "search"
        p3 = "sMultiMovieYn="
        v3 = ""
        p4 = "sRepNationCd="
        v4 = ""
        p5 = "sWideAreaCd="
        v5 = ""


            With WinHttp

                .Open "get", "" & Url & p1 & v1 & bridge & p2 & v2 & bridge & p3 & v3 & bridge & p4 & v4 & bridge & p5 & v5 & ""
                .SetRequestHeader "Referer", "http://www.kobis.or.kr/kobis/business/stat/boxs/findFormerBoxOfficeList.do?"
                .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                .Send
                .WaitForResponse ': DoEvents

                sResponse = StrConv(.responseBody, vbUnicode)

            Dim hforms As HTMLFormElement

            With html
                .body.innerHTML = sResponse
                sResponse = ""


                Set hTable = .getElementsByClassName("boardList03")(0)
            End With

            Dim Arr0() As Variant
            Dim tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long
            r = 0
            With ws
                Set tRow = hTable.getElementsByTagName("tbody")(0).getElementsByTagName("tr")

                ReDim Arr0(tRow.Length - 1, 10)
                For Each tr In tRow
                    r = r + 1
                    Set tCell = tr.getElementsByTagName("td")

                Dim j As Integer

                    c = 1
                    For Each td In tCell

                        If td.ID = "td_rank" Then
                        Arr0(r - 1, 0) = td.innerText
                        End If

                        If td.ID = "td_movie" Then
                        Arr0(r - 1, 1) = td.getElementsByTagName("a")(0).innerText
                        End If

                        If td.ID = "td_openDt" Then
                        Arr0(r - 1, 2) = td.innerText
                        End If

                        If td.ID = "td_salesAcc" Then
                        Arr0(r - 1, 3) = td.innerText
                        End If

                        If td.ID = "td_audiAcc" Then
                        Arr0(r - 1, 4) = td.innerText
                        End If

                        If td.ID = "td_scrnCnt" Then
                        Arr0(r - 1, 5) = td.innerText
                        End If

                        If td.ID = "td_showCnt" Then
                        Arr0(r - 1, 6) = td.innerText
                        End If

                        c = c + 1
                    Next td

                Next tr

                Dim k As Integer
                Dim i As Integer

                k = 0
                For i = LBound(Arr0, 1) To UBound(Arr0, 1)

                                           .Cells(2 + k + g, 2) = Arr0(i, 0)
                                           .Cells(2 + k + g, 3) = Arr0(i, 1)

                                           .Cells(2 + k + g, 4) = Arr0(i, 2)
                                           .Cells(2 + k + g, 5) = Arr0(i, 3)
                                           .Cells(2 + k + g, 6) = Arr0(i, 4)
                                           .Cells(2 + k + g, 7) = Arr0(i, 5)
                                           .Cells(2 + k + g, 8) = Arr0(i, 6)
                        k = k + 1
                Next i
            End With

        Erase Arr0

        Set tRow = Nothing: Set tCell = Nothing: Set tr = Nothing: Set td = Nothing
        Set hforms = Nothing
        Set hTable = Nothing


        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

        End Sub
-1
김기성 6 listopad 2018, 20:29

1 odpowiedź

Najlepsza odpowiedź

Możesz po prostu chwycić tabelę za jej identyfikator, a następnie zapętlić wiersze tabeli i komórki tabeli w wierszach.

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, hTable As HTMLTable
    Const MAX_WAIT_SEC As Long = 5
    Application.ScreenUpdating = False
    With IE
        .Visible = True
        .navigate "http://www.kobis.or.kr/kobis/business/stat/boxs/findFormerBoxOfficeList.do?loadEnd=0&searchType=search&sMultiMovieYn=&sRepNationCd=&sWideAreaCd="

        While .Busy Or .readyState < 4: DoEvents: Wend

        Set hTable = .document.getElementById("table_former")

        WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")

        .Quit
        Application.ScreenUpdating = True
    End With

End Sub


Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)

    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long, tBody As Object
    r = startRow
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            .Cells(startRow, columnCounter) = header.innerText
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody               'HTMLTableSection
            Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow
            For Each tr In tRow
                r = r + 1
                Set tCell = tr.getElementsByTagName("td")
                c = 1
                For Each td In tCell             'DispHTMLElementCollection
                    .Cells(r, c).Value = td.innerText 'HTMLTableCell
                    c = c + 1
                Next td
            Next tr
        Next tSection
    End With
End Sub

Referencje (VBE & GT; Narzędzia & GT; Referencje):

  1. Biblioteka obiektów HTML firmy Microsoft
  2. Microsoft Internet Controls
0
QHarr 7 listopad 2018, 00:02