엑셀 크롤링 관련해서 질문드립니다.
카카오채널에서 쇼핑몰을 만들어서 고객님 명단을 댓글에서 추출해서 DB로 관리할려고 연습중인데요.
(참고로 채널은 제 채널은 아니고 만들때 참고할려고 찾은 채널입니다.) 아래 사진에 나오는것 처럼 나눠서
추출할려고 하는데요.
실행하면 일부분 추출이 되지만 홈페이지 처음 들어갔을때 나오는 댓글 15개만 추출되고
댓글 더보기 눌러야지 보이는 댓글들은 추출이 안되요.
그리고 15개 추출될때 추출되고 나면 런타임 오류가 발생하는데
어떻게 해야지 해결될까요?원래 제가 똑같은 내용으로 질문을 드렸는데 질문한 코드가 잘못되서....
다시한번 또 물어봅니다.친절한 답변 기다리겠습니다.
추출할 값
사용한 코드
Option Explicit
Public Sub parsehtml()
Dim http As Object, html As New HTMLDocument, topics As Object, titleElem As Object, detailsElem As Object, topic As HTMLHtmlElement
Dim i As Integer
'// 익스플로어(XML변수 설정)
Set http = CreateObject("MSXML2.XMLHTTP")
'// 검색 (XML 요청)
http.Open "GET", "https://pf.kakao.com/_ElxfrT/53587918", False
http.send
html.body.innerHTML = http.responseText
'// HTML 추출
Set topics = html.getElementsByClassName("item_cmt")
i = 2
'// 개체 검색
For Each topic In topics
'// 요소별 값 추출
Set titleElem = topic.getElementsByTagName("div")(2)
Set detailsElem = topic.NextSibling.getElementsByTagName("div")(1)
Sheets(1).Cells(i, 1).Value = detailsElem.getElementsByTagName("strong")(0).innerText
Sheets(1).Cells(i, 2).Value = detailsElem.getElementsByTagName("p")(0).innerText
Sheets(1).Cells(i, 3).Value = detailsElem.getElementsByTagName("span")(0).innerText
i = i + 1
Next
End Sub
안녕하세요.
우선 runtime오류는 아래와 같이 selection하면 정확히 얻어 올수 있습니다. Div tag로 selection하는 부분을 class로 읽어오는 것으로 변경하였습니다. 각각의 topic안에는 class가 되어 있더라구요.
Set topics = html.getElementsByClassName("item_cmt") Debug.Print topics.Length '//http.document.querySelector("#mArticle > div > div:nth-child(2) > div.post_cmt > div.cmt_bundle > button").Click i = 2 '// 개체 검색 For Each topic In topics '// 요소별 값 추출 Debug.Print "iteration " & i Debug.Print "1) " & topic.getElementsByClassName("txt_name").Item.innerText Debug.Print "2) " & topic.getElementsByClassName("desc_cmt").Item.innerText Debug.Print "3) " & topic.getElementsByClassName("txt_time").Item.innerText Debug.Print "\n" Sheets(1).Cells(i, 1).Value = topic.getElementsByClassName("txt_name").Item.innerText Sheets(1).Cells(i, 2).Value = topic.getElementsByClassName("desc_cmt").Item.innerText Sheets(1).Cells(i, 3).Value = topic.getElementsByClassName("txt_time").Item.innerText i = i + 1 Next문제는 더보기 버튼을 눌러야 나오는 부분인데요,
처음에 접속을 하게 되면 해당 웹 페이지에서 더보기를 눌러야지만 추가 데이터를 얻을수가 있습니다. 파이썬이나 javascript면 훨씬 쉬운데요,
Doc.getElementsByClassName("item_cmt")(2).Click이렇게 제일 처음으로 가기를 누르고, 이후에 계속해서 더보기를 눌러서 전체 글이 보이게 하려고 했는데요,
Doc.getElementsByClassName("btn_more").Click여기서 문제는 처음 접속할때 이 버튼이 없습니다. 저도 VBA로 이걸 처리하는 부분은 모르겠습니다.
여기서 필요한 기능은 첫번째 클릭을 누른후에, update된 DOM의 값을 가져와야 하는데요, 이건 다른 분께 질문을 하시는 것이 좋을 것 같습니다.
엑셀도 개체를 바꾸어서 하니 파이썬처럼 잘 됩니다. 아래 코드로 한번 실행해 보세요. Reference에서 Microsoft HTML Object Library와 Microsoft Internet Controls를 추가하셔야 합니다. 위에 tag선택하는 걸 class로 바꾼 코드에, 더보기 버튼을 내용이 있을때까지 계속 누르는 것을 추가했고, 중간 중간에 debug console로 내용을 찍어서 흐름을 쉽게 이해하실수 있게 해 놓았습니다. 나중에 debug문은 지우셔도 됩니다.
Sub test() Dim ie As New InternetExplorer Dim doc As New HTMLDocument Dim itemArray As Object ie.Visible = True ie.Navigate "https://pf.kakao.com/_ElxfrT/53587918" Do DoEvents Loop Until ie.ReadyState = READYSTATE_COMPLETE Set doc = ie.Document 'button press and update 'basic extraction test Debug.Print doc.getElementsByClassName("btn_cmt").Length doc.getElementsByClassName("btn_cmt")(2).Click Application.Wait (Now + TimeValue("0:00:5")) For i = 1 To 10 Set moreButton = doc.getElementsByClassName("btn_more")(0) If Not moreButton Is Nothing Then moreButton.Click Debug.Print "touch more button" Application.Wait (Now + TimeValue("0:00:5")) Else Debug.Print "There are no more button to touch" Exit For End If 'print updated length Set itemCmt = doc.getElementsByClassName("item_cmt") Debug.Print "itemCmt length after refresh " & itemCmt.Length Next Set itemCmt = doc.getElementsByClassName("item_cmt") Debug.Print "itemCmt length " & itemCmt.Length i = 2 For Each eachCmt In itemCmt Sheets(1).Cells(i, 1).Value = eachCmt.getElementsByClassName("txt_name").Item.innerText Sheets(1).Cells(i, 2).Value = eachCmt.getElementsByClassName("desc_cmt").Item.innerText Sheets(1).Cells(i, 3).Value = eachCmt.getElementsByClassName("txt_time").Item.innerText i = i + 1 Next ie.Quit Set ie = Nothing End Sub