본문 바로가기
SELENIUM/VBA

VBA 블로그에 댓글 작성자 목록 엑셀 시트에 추출

by 에버리치60 2023. 12. 28.

내 블로그에 댓글 작성하신 분 목록을 추출 해보자.

아래와 같은 블로그에 댓글을 작성하신 분의 아이디(별명)을 VBA와 셀레니움을 이용하여 엑셀 시트로 추출하고 누적 해보자.

 

 

1. 엣지 브라우저를 열어 네이버 블로그에 로그인 한다.

Sub 엣지드라이버시작()
    On Error GoTo edgerror
    Dim myid, mypwd As String
    Dim Keys As New Selenium.Keys
    Dim edgever() As String
    
    Set Sel = New Selenium.EdgeDriver
    Sel.Start
    '브라우저 크기 지정
    Sel.Window.SetSize 1200, 960
네이버로그인:
    myid = "네이버 아이디"
    mypwd = "네이버 비밀번호"
    Sel.Get "https://nid.naver.com/nidlogin.login?mode=form"
    While Sel.ExecuteScript("return document.readyState") <> "complete"
        DoEvents
    Wend
    '아이디를 클립보드에 복사
    Sel.SetClipBoard myid
    '클립보드에 아이디를 아이디 입력 난에 붙여넣기
    Sel.FindElementById("id").SendKeys (Keys.Control + "v")
    Sel.Wait 500

    '비밀번호를 클립보드에 복사
    Sel.SetClipBoard mypwd
    '클립보드에 비밀번호를 비밀번호 입력난에 붙여넣기
    Sel.FindElementById("pw").SendKeys (Keys.Control + "v")
    Sel.Wait 500
    
    '로그인 상태유지
    'Sel.FindElementByXPath("//*[@id='login_keep_wrap']/div[1]/label").Click
    'Sel.Wait 500
    
    '로그인버튼
    Sel.FindElementById("log.login").Click
    Sel.Wait 500

    Exit Sub
edgerror:
    '엣지가 열리지 않으면 크롬을 열어 엣지 드라이버 다운
    If (Err.Number = 33) Then
        edgever = Split(Err.Description, "n is ")
        edgever = Split(edgever(1))
        MsgBox "현재 브라우저 버전 " & edgever(0) & "에 맞는 엣지드라이버를 SeleniumBasic 폴더에 다운받아 넣으시오!"
        Call 크롬드라이버시작
        Sel.Get "https://developer.microsoft.com/ko-kr/microsoft-edge/tools/webdriver/"
            While Sel.ExecuteScript("return document.readyState") <> "complete"
        Wend
    Else
        MsgBox "Error " & Err.Number & " " & Err.Description
    End If
End Sub

 

 

2. 댓글 목록을 열어서 엑셀 시트로 가져오기

 

Sub 댓글단자_목록()
    Dim ele, ele2, ele3 As WebElement
    Dim k As Integer
    Dim pg, maxpg As Integer
    Dim url As String
    
    
    maxpg = 20
    k = Cells(1, 2) + 1
    For pg = 1 To maxpg
        url = "https://admin.blog.naver.com/AdminNaverCommentManageView.naver?paging.commentSearchType=0&paging.economyTotalCount=1100&paging.commentSearchValue=&blogId=블로그아이디&paging.currentPage=" & pg
        Sel.Get url
        While Sel.ExecuteScript("return document.readyState") <> "complete"
            DoEvents
        Wend
        Sel.Wait 1200
        For Each ele In Sel.FindElementByXPath("//*[@id='tableListById']").FindElementsByTag("tr")
            DoEvents
            '네이버 아이디/별명/작성일/댓글내용/글제목
            Cells(k, 1) = ele.FindElementsByClass("blogid").Item(1).Text
            Cells(k, 2) = ele.FindElementsByClass("nickname").Item(1).Text
            'Cells(k, 5) = ele.FindElementsByClass("link").Item(1).Text
            'Cells(k, 3) = Left(ele.FindElementsByClass("desc1").Item(2).Text, 10)
            k = k + 1
        Next
    Next
날자다름:
    '중복제거
    Range("A2:B" & k - 1).RemoveDuplicates 1, xlNo
    Cells(1, 2) = Cells(Rows.Count, 1).End(xlUp).Row
End Sub

 

 

maxpg = 20

댓글 목록에서 1페이지 부터 20페이지까지 읽어 오기

 

k = Cells(1, 2) + 1

B1 셀에 마지막 목록의 위치 보관

 

url = "https://admin.blog.naver.com/AdminNaverCommentManageView.naver?paging.commentSearchType=0&paging.economyTotalCount=1100&paging.commentSearchValue=&blogId=블로그아이디&paging.currentPage=" & pg

블로그 댓글 목록을 가져오기 위한 URL

 

Cells(k, 1) = ele.FindElementsByClass("blogid").Item(1).Text

Ak 셀에 블로그 아이디를 찾아서 넣기

 

Cells(k, 2) = ele.FindElementsByClass("nickname").Item(1).Text

Bk 셀에 블로그 별명을 찾아서 넣기

 

Range("A2:B" & k - 1).RemoveDuplicates 1, xlNo

아이디가 중복된 것은 삭제하기

 

Cells(1, 2) = Cells(Rows.Count, 1).End(xlUp).Row

마지막 목록의 위치를 B1 셀에 넣기