[엑셀vba] EBS 방송국 편성표 가져와보기

두번째 웹 크롤링 EBS 방송국 편성표 가져오기!

--------------------------------------------------------------------------------------

매크로 순서

1. 편성표 출력할 날짜입력과 방송국 선택 (디폴트: 오늘 날짜, EBS1 선택)

2. 주어진 조건에 맞는 웹 페이지 오픈

3. 방송시간과 프로그램명 셀에 출력

4. 매크로 끝

다시 시작하면 기존 내용은 삭제됨

--------------------------------------------------------------------------------------

깨달은 점

1. EBS 방송국은 많다. 편성표 기준 8곳

EBS편성표출력하기.xlsm

0.05MB

Sub Main_Macro()

    Application.ScreenUpdating = False '매크로 실행 중 엑셀 업데이트 중지

    Dim URL As String 'URL 주소
    Dim sch_Date As String '검색할 날짜 변수
    Dim i As Integer '반복 횟수 카운트
    Dim Choice_TV As String '편성표 검색 할 방송국
    Dim Title_Time As String '방속제목과 시간 변수
    Dim Browser As InternetExplorer ' Explorer 변수
    Dim HTMLDoc As IHTMLDocument 'HTML 태그 불러오는 변수
    Dim Contents As IHTMLElement '편성표 정보 담을 변수
    Dim timeLine As IHTMLElement '프로그램 정보 담을 변수

    On Error GoTo Err_Check

    Range(Cells(10, "A"), Cells(300, "F")).ClearContents

    '--------------------------------------------- 날짜 입력 확인 ---------------------------------

    If Len(Cells(1, "B")) < 1 Then


        rst_date = MsgBox("오늘 날짜로 출력할래요?.", vbYesNo, "날짜 없음") 'yes 선택이면 6, no 선택이면 7 값 리턴됨

        If rst_date = 6 Then

            Cells(1, "B") = Date
        Else

            Cells(1, "B").Select '편성표 검색날 날짜가 없으면 매크로 종료
            Exit Sub

        End If

    End If

    '--------------------------------------------- 변수 초기화 ---------------------------------

    Choice_TV = Cells(3, "B") '선택한 방송국 변수에 입력

    If Choice_TV = "" Then
        Choice_TV = Cells(1, "I") '방송국 선택되지 않으면 기본 EBS1로 설정
    Else
        Select Case Choice_TV ' 선택된 방송국의 url 파라미터 값을 찾기, i열에는 url에 들어갈 방송국 파라미터가 있음
                              ' ebs1 = tv, ebs2 = tv2, plus1 = plus1 등 ...
        Case Cells(1, "H")
            Choice_TV = Cells(1, "I")
        Case Cells(2, "H")
            Choice_TV = Cells(2, "I")
        Case Cells(3, "H")
            Choice_TV = Cells(3, "I")
        Case Cells(4, "H")
            Choice_TV = Cells(4, "I")
        Case Cells(5, "H")
            Choice_TV = Cells(5, "I")
        Case Cells(6, "H")
            Choice_TV = Cells(6, "I")
        Case Cells(7, "H")
            Choice_TV = Cells(7, "I")
        Case Cells(8, "H")
            Choice_TV = Cells(8, "I")
        End Select
    End If


    sch_Date = Replace(Cells(1, "B"), "-", "") '검색 날짜 변수에 넣기

    URL = "https://www.ebs.co.kr/schedule?channelCd=" & Choice_TV & "&date=" & sch_Date & "&onor=" & Choice_TV '방송국 파라미터와 날짜를 url에 넣고 변수저장

    Cells(7, "A") = Year(Cells(1, "B")) & "년 " & Month(Cells(1, "B")) & "월 " & Day(Cells(1, "B")) & "일 " & Chr(10) & Cells(3, "B") & " 편성표"


    '-------------------------------------------- 웹1. 컨트롤 시작 ---------------------------------------------------------

    Set Browser = New InternetExplorer
    Browser.Silent = True
    Browser.Visible = False 'True = 인터넷 창 보임, False = 인터넷 창 숨김
    Browser.navigate URL 'URL 변수에 있는 주소로 이동

    Wait_Browser Browser '페이지 로딩 끝나면 코드 진행

    Set HTMLDoc = Browser.document 'HTML 소스 불러오기

    '-------------------------------------------- 웹2. 편성표 출력 ------------------------------------


    Set Contents = HTMLDoc.getElementsByClassName("main_timeline").Item

    For i = 0 To 300

        Set timeLine = HTMLDoc.getElementById(i & "layer_preview")

        Title_Time = timeLine.Children.Item(0).innerText

        If Month(Cells(1, "B")) < 10 And Day(Cells(1, "B")) > 9 Then

            Cells(i + 10, "A") = Mid(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-" & Day(Cells(1, "B"))) - 1, 12)
            Cells(i + 10, "B") = Replace((Left(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-" & Day(Cells(1, "B"))) - 2)), Chr(10), "")

        ElseIf Month(Cells(1, "B")) < 10 And Day(Cells(1, "B")) < 10 Then

            Cells(i + 10, "A") = Mid(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-0" & Day(Cells(1, "B"))) - 1, 12)
            Cells(i + 10, "B") = Replace((Left(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-0" & Day(Cells(1, "B"))) - 2)), Chr(10), "")

        ElseIf Month(Cells(1, "B")) > 10 And Day(Cells(1, "B")) > 9 Then

            Cells(i + 10, "A") = Mid(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-" & Day(Cells(1, "B"))), 12)
            Cells(i + 10, "B") = Replace((Left(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-" & Day(Cells(1, "B"))) - 1)), Chr(10), "")

        ElseIf Month(Cells(1, "B")) > 10 And Day(Cells(1, "B")) < 10 Then

            Cells(i + 10, "A") = Mid(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-0" & Day(Cells(1, "B"))), 12)
            Cells(i + 10, "B") = Replace((Left(Title_Time, InStr(1, Title_Time, Month(Cells(1, "B")) & "-0" & Day(Cells(1, "B"))) - 1)), Chr(10), "")

        End If

    Next i


Err_Check:
        If Err <> 0 Then
            Err.Clear
            Exit Sub
        End If

End Sub

매크로 시작 화면

그냥 실행한 경우