웹페이지 정보를 추출하는 스크래핑, 최근 그런 것이 있다고 들어 넷에서 뒤지니 10년 이상 된 기술. WinHTTP 또는 XLM 기반 또는 브라우저 기반이 있나 보다. 후자는 인터넷 익스플로러로 만든 게 태반인데 요즘 서비스 종료 탓에 5년 전 부터 셀레니움(Selenium) 라이브러리를 많이 쓰는 모양. 전자는 빠르고 어려운 반면 후자가 느리지만 쉽단다.
***
일본은 전세가 없고 (아마 전세는 한국 고유의 제도이지 싶다) 매매 아니면 임대인데, 월세를 얻기 위해 대개 부동산업체를 통하는데 성사되면 수수료를 줘야 한다. 집 주인에게는 빌려줘서 고맙다는 사례금을 1개월치 집세 상당 금액으로 지불한다 (お礼金;oreikin). 즉, 복덕방과 집 주인에게 각각 (최소) 1개월치, 눈 튀어나오는 관행인데 다들 그렇게 산다.
UR맨션은 그런 돈 지불하지 않아도 되는 공공기구가 운영하는 곳인데, 당연히 인기가 높아 매물이 나오자마자 빠지기 십상이다. 나는 어쩌다 UR에만 14년 살다 나왔는데 나오고 나니 UR좋은 줄 알겠더라는. 집을 사지 않는 한 언제고 기회가 있다면 다시 돌아갈 생각이다.
***
웹 스크래핑이라면 여러 아이디어가 있는데, 그 중 완결한 UR맨션 물건 검색 프로그램을 정리한다.
1. 웹사이트 접속, 다양한 검색 옵션으로 검색 결과 화면의 URL을 복사,
2. 엑셀 시트에 붙여 넣고 프로그램 가동하면 아래 화면 처럼 정리된 결과를 얻는다.
프로그램의 취지, 가동 경위를 설명하기 위한 유튜브 영상을 링크해둔다.
마지막으로 코드. 웹 스크래핑은 자칫 서버 부하를 증가시켜 언제든 업무 방해죄에 걸릴 소지가 있다. 일본에선 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일)
'Skills > Excel VBA' 카테고리의 다른 글
Stop 또는 중단점이 안 먹힐 때 (0) | 2023.10.26 |
---|---|
VBEditor (일본어) 글자 깨질 때 (0) | 2023.09.19 |
Sort 속도 비교 (Quick vs. Bubble) (0) | 2023.08.26 |
Creating Daily Sheet (0) | 2023.08.07 |
폴더 내 파일 리스트, 파일명 변경 (rename) (0) | 2012.03.16 |