Skills/Excel VBA

아파트 검색 - VBA 스크래핑 (셀레니움+크롬)

섬그늘 2023. 9. 10. 18:11

웹페이지 정보를 추출하는 스크래핑, 최근 그런 것이 있다고 들어 넷에서 뒤지니 10년 이상 된 기술. WinHTTP 또는 XLM 기반 또는 브라우저 기반이 있나 보다. 후자는 인터넷 익스플로러로 만든 게 태반인데 요즘 서비스 종료 탓에 5년 전 부터 셀레니움(Selenium) 라이브러리를 많이 쓰는 모양. 전자는 빠르고 어려운 반면 후자가 느리지만 쉽단다.

 

***

 

일본은 전세가 없고 (아마 전세는 한국 고유의 제도이지 싶다) 매매 아니면 임대인데, 월세를 얻기 위해 대개 부동산업체를 통하는데 성사되면 수수료를 줘야 한다. 집 주인에게는 빌려줘서 고맙다는 사례금을 1개월치 집세 상당 금액으로 지불한다 (お礼金;oreikin). 즉, 복덕방과 집 주인에게 각각 (최소) 1개월치, 눈 튀어나오는 관행인데 다들 그렇게 산다. 

 

UR맨션은 그런 돈 지불하지 않아도 되는 공공기구가 운영하는 곳인데, 당연히 인기가 높아 매물이 나오자마자 빠지기 십상이다. 나는 어쩌다 UR에만 14년 살다 나왔는데 나오고 나니 UR좋은 줄 알겠더라는. 집을 사지 않는 한 언제고 기회가 있다면 다시 돌아갈 생각이다.

 

***

 

웹 스크래핑이라면 여러 아이디어가 있는데, 그 중 완결한 UR맨션 물건 검색 프로그램을 정리한다. 

1. 웹사이트 접속, 다양한 검색 옵션으로 검색 결과 화면의 URL을 복사,

2. 엑셀 시트에 붙여 넣고 프로그램 가동하면 아래 화면 처럼 정리된 결과를 얻는다.

 

프로그램의 취지, 가동 경위를 설명하기 위한 유튜브 영상을 링크해둔다.

 

UR임대주택 검색

 

마지막으로 코드. 웹 스크래핑은 자칫 서버 부하를 증가시켜 언제든 업무 방해죄에 걸릴 소지가 있다. 일본에선 2010년 도서관 검색 사이트에서 기계로 정보 추출을 시도, 기소유예된 사례가 있단다. 그래서 해당 사이트인 UR을 뒤져봤는데 딱히 (스크래핑 하면 재미없다 식의) 삭막한 문구는 눈에 띄이지 않았다.

 

경건하게 사이트 건드릴 때 마다 지연시간을 충분히 두도록 신경 썼다. 뭐...그런 선량한 의지 때문만이라기 보다는, 그러지 않고 넷 속도가 맞지 않으면 제대로 데이타 추출할 시간을 벌지 못해 에러 유발하는 수가 있다. 하여튼 이런저런 심모원려 있어 엑셀 파일 자체는 첨부하지 않는 게 좋겠다.

 

(quote)


Sub UR_Search()

'coded by ishade at Sep.10th.(Sun),2023
'scrapping main information of 'bukken' in selected url of UR in Japan

    Dim Sel As Selenium.ChromeDriver
    Dim Cmplxs As Selenium.WebElements
    Dim Rooms As Selenium.WebElements
    Dim Links As Selenium.WebElements       'complex link
    Dim RLinks As Selenium.WebElements      'room link
    Dim Buttons As Selenium.WebElements
    Dim Button As Selenium.WebElement
    Dim Nextpage As Selenium.WebElement
      
    Dim Rcnt As Long                    'Row Counter
    Dim Room As Long                    'no. of rooms of the complex
    Dim Rno As Integer                  'serial room number of the page
    Dim Rttl As Integer
    Dim i As Long, j As Long, k As Long
    Dim S1 As Integer, S2 As Integer    'start/end of instr String
    Dim Page As Integer
    Dim MyStr As String
    Dim ToStr As String, GoStr As String    'goutou, gositsu
    Dim Item() As Variant
    Dim Etime As Integer, Ttime As Integer  'time to expand, transfer page
    Dim Rcol As Integer, Rrow As Integer    'row and column to write table
    
    Set Sel = New Selenium.ChromeDriver
    Sel.Start ("Chrome")
    Sel.Get Range("C2").Value
    
    While Sel.ExecuteScript("return document.readyState") <> "complete"
        Sel.Wait (1000)
    Wend

    MyStr = Range("B5").Value
    ToStr = Range("B6").Value               'complex name title - goutou
    GoStr = Range("B7").Value               'room no. title - gositsu
    Etime = Range("C10").Value * 1000       'extension time to expand the hidden rooms
    Ttime = Range("C11").Value * 1000       'transfer time to page change
    
    Rcol = 5
    Rcnt = 5                                'row to start writing
    Page = 1
    Rttl = 0
    
    Item = Array(MyStr, "住所", "空室", "No.", ToStr, GoStr, "家賃", "公益", "LDK", "㎡", "階", "page")

    Range("D:P").Clear                                              'yes, D.P in Neflex was impressive
    For i = 0 To UBound(Item)
        Cells(4, i + Rcol).Value = Item(i)
    Next i
    
    Item = Array(ToStr, GoStr, "円", "円)", " /", "㎡", "階")
    
    Do                                                'run each page to last
    
        Set Cmplxs = Sel.FindElementsByClass("searchs_property_head")                  'complex search
        Set Buttons = Sel.FindElementsByClass("module_buttons_more")    'more search button
        
        For i = 1 To Buttons.Count                                      'if there is hidden goods, show it throughly
            j = 1
            Do While Len(Buttons(i).Text) > 0
                Buttons(i).Click
                Sel.Wait (Ttime)
                j = j + 1
                If j > 10 Then Stop                                    'something wrong
            Loop
        Next i

    'now, writing
        Set Rooms = Nothing
        Sel.Wait (Etime)
        Set Rooms = Sel.FindElementsByClass("js-log-item")
'        Debug.Print Rooms.Count, Rooms(1).Text
        
        Rno = 0
        
        For k = 1 To Cmplxs.Count
            
            Room = Cmplxs(k).FindElementByClass("rep_bukken-count-room").Text                  'no.of rooms of the complex
            If Room = 0 Then Exit Do                 'means end of bukken data of this site
            
            Set Links = Cmplxs(k).FindElementsByTag("a")
            Cells(Rcnt, Rcol).Value = Cmplxs(k).FindElementByClass("rep_bukken-name").Text      'complex name
            Cells(Rcnt, Rcol + 1).Value = Cmplxs(k).FindElementByCss("div > div.cassettes_property_contents > div.item_upper > div > ul > li:nth-child(2) > div > div.item_maininfolist_body > div").Text
            ActiveSheet.Hyperlinks.Add Cells(Rcnt, Rcol), Links(1).Attribute("href")               'insert complex link
            Cells(Rcnt, Rcol + 2).Value = Room

            For i = 0 To Room - 1
                Cells(Rcnt, Rcol + 3).Value = i + 1      'series no. of vacant room of the complex
                Set RLinks = Rooms(2 * Rno + 1).FindElementsByTag("a")
                ActiveSheet.Hyperlinks.Add Cells(Rcnt, Rcol + 3), RLinks(1).Attribute("href")   'room link
                
                MyStr = Rooms(2 * Rno + 1).Text
                MyStr = " " & Replace(MyStr, Chr(10), " ")

                For j = 0 To UBound(Item)
                    S2 = InStr(1, MyStr, Item(j))
                    If S2 > 0 Then
                        S1 = InStrRev(MyStr, " ", S2 - 1)
                        ToStr = Mid(MyStr, S1, S2 - S1)
                        ToStr = Replace(ToStr, " ", "")
                        ToStr = Replace(ToStr, "(", "")
                        ToStr = Replace(ToStr, ")", "")

                        If j = 0 Then
                            Cells(Rcnt, Rcol + 4 + j).Value = "'" & ToStr
                        Else
                            Cells(Rcnt, Rcol + 4 + j).Value = ToStr
                        End If
                     End If
                Next j

                Cells(Rcnt, Rcol + 11).Value = Page                 'page no. of the search
'                Application.Goto reference:=ActiveSheet.Cells(Rcnt, Rcol + 11), Scroll:=True

                Rcnt = Rcnt + 1
                Rno = Rno + 1
                Rttl = Rttl + 1
                
            Next i
        Next k
        
        Set Nextpage = Sel.FindElementByClass("pagerblock_next")
        If Len(Nextpage.Text) = 0 Then Exit Do                        'if it is last page, end procedure.
'        Debug.Print Page, Nextpage.Text
        Nextpage.Click
        
        Sel.Wait (Ttime)
        Page = Page + 1
        
    Loop
    
    MsgBox Rttl & "bukken have been listed.", vbYes
    
    Sel.Close
    Set Sel = Nothing
    
End Sub

 

(unquote)     (2023-09-10일)