고수분들 도와주세요!! 도서관 책의 일렬번호를 매크로? 크롤링? 시킬 수는 없을까요?

기능/도구
작성자
Gemma
작성일
2021-10-13 15:06
조회
68
엑셀버전 : M365

운영체제 : 윈도우10

안녕하세요!

저는 엑셀의 매크로나 크롤링쪽은 잘 모른는 초보입니다 ㅠㅠ (다운받아서 적용해서 쓰는 수준)

야 나두 엑셀에서 XIMAGE나 이런건 다운받아서 잘 응용해서 사용하고 있는데요.. (너무 감사합니다!)

 

혹시 도서관의 책 일렬번호를 자동으로 다운받을 수 는 없을까 하여 문의드립니다.

제가 매주마다 노가다를 하고 있거든요...

도서관 사이트에서 책 제목을 검색하고, 나오는 청구기호 (책의 고유정리번호?)를 일일히 복사해서 엑셀로 정리하는 작업을 하고있어요.

혹시 이걸 자동화 시킬 수는 없을까요?

 

혹시나 아시는 분이 있다면... 간절히!! 도움을 요청드립니다.

 

도서관사이트

https://www.ydplib.or.kr/

 

관련 파일 (첨부했습니다!)

 

아양 843-C536s

전체 6

  • 2021-10-14 14:06
    채택된 답변
    Private Type BOOK_STRUCT
        BookName As String ' # 책 이름
        BookCode As String ' # 등록번호
        Library As String ' # 도서관
    End Type
    
    Public Sub automatic()
    
    On Error GoTo Err
        Dim bookInfor() As BOOK_STRUCT, i As Integer
        Dim searchBookName As String
        Dim searchBookRecord As Integer
        
        searchBookName = Range("B2").Value ' # 찾으려는 책 제목
        searchBookRecord = CInt(Range("B3").Value) ' # 검색 결과 레코드, 값이 크면 클수록 가져오는 데이터에 비례하여 속도가 늦어질 수 있음
        Call setBookInfor(bookInfor, searchBookName, searchBookRecord)
        
        For i = 0 To UBound(bookInfor)
            Sheets("Sheet2").Cells(i + 6, 1) = bookInfor(i).BookName ' # 책이름
            Sheets("Sheet2").Cells(i + 6, 2) = bookInfor(i).Library ' # 도서관
            Sheets("Sheet2").Cells(i + 6, 3) = bookInfor(i).BookCode ' # 등록번호
        Next
        
        Erase bookInfor
        
        MsgBox "파싱 완료", vbInformation, "완료"
        Exit Sub
    Err:
        MsgBox "찾는책이 존재하지 않습니다.", vbCritical, "오류"
        Err.Clear
    End Sub
    Private Sub setBookInfor(ByRef bookInfor() As BOOK_STRUCT, searchBookName As String, searchRecord As Integer)
    
        Dim Html As HTMLDocument
        Dim tagCount As Integer, i As Integer
    
        temp = getHttpSource(BookName, searchRecord)
        
        Html.body.innerHTML = temp
        
        tagCount = Html.getElementsByClassName("resultList imageType")(0).getElementsByTagName("li").Length
        ReDim bookInfor(tagCount - 1)
        
        i = 0
        For Each oElement In Html.getElementsByClassName("resultList imageType")(0).getElementsByTagName("li")
            bookInfor(i).BookName = oElement.getElementsByTagName("a")(1).innerText
            bookInfor(i).BookCode = Trim(Split(oElement.getElementsByTagName("dd")(1).getElementsByTagName("span")(1).innerText, ":")(1))
            bookInfor(i).Library = Trim(Split(oElement.getElementsByTagName("dd")(2).getElementsByTagName("span")(0).innerText, ":")(1))
            i = i + 1
        Next
    End Sub
    
    
    Private Function getHttpSource(BookName As String, searchRecord As Integer) As String
        Dim WinHttp As Object
        Set WinHttp = CreateObject("winhttp.winhttprequest.5.1")
        Dim pageUrl As String
        
        pageUrl = "https://www.ydplib.or.kr/intro/menu/10003/program/30001/plusSearchResultList.do?searchType=SIMPLE&searchMenuCollectionCategory=&searchCategory=ALL" & _
                            "&searchKey1=&searchKey2=&searchKey3=&searchKey4=&searchKey5=&searchKeyword1=&searchKeyword2=&searchKeyword3=&searchKeyword4=&searchKeyword5=&searchOperator1=&searchOperator2=&searchOperator3=&searchOperator4=&searchOperator5=&searchPublishStartYear=&searchPublishEndYear=&searchRoom=&searchKdc=&searchIsbn=¤tPageNo=1&viewStatus=IMAGE&preSearchKey=TITLE&" & _
                            "preSearchKeyword=" & WorksheetFunction.EncodeURL(BookName) & "&searchKey=TITLE&searchKeyword=" & WorksheetFunction.EncodeURL(BookName) & _
                            "&searchLibrary=ALL&searchLibraryArr=CA&searchLibraryArr=CB&searchLibraryArr=CC&searchLibraryArr=MA&searchLibraryArr=LF&searchLibraryArr=LG&searchLibraryArr=LR&searchLibraryArr=LS&searchLibraryArr=LT&searchLibraryArr=LH&searchLibraryArr=LU&searchLibraryArr=LI&searchLibraryArr=LL&searchLibraryArr=LC&searchLibraryArr=LM&searchLibraryArr=LN&searchLibraryArr=LO&searchLibraryArr=LP&searchLibraryArr=LQ&" & _
                            "searchLibraryArr=LJ&searchLibraryArr=LK&searchLibraryArr=LE&searchLibraryArr=LA&searchLibraryArr=LD&searchLibraryArr=LB&searchLibraryArr=CD&searchSort=SIMILAR&searchOrder=DESC&searchRecordCount=" & searchRecord
        
        WinHttp.Open "GET", pageUrl
        WinHttp.Send
        
        WinHttp.WaitForResponse
        
        getHttpSource = WinHttp.ResponseText
    End Function
    
    

    스스코드 및 첨부파일 참고하세요.

     

    캡처.JPG

    첨부파일 : 도서관-청구기호-정리.xlsm


    • 2021-10-19 13:14

      너무 감사드립니다!!!!!!!!
      이걸로 보다 쉽게 작업할 수 있을것 같아요!

      혹시 한가지 더 궁금한게 있는데.. 뭔가의 책리스트를 받으면 그걸 자동으로 검색해서 결과지를 만들수 있게 하는 방법은 없을까요? 이건 욕심이긴 하지만요. 일단 위 결과만으로도 너무 감사드립니다~!!!!!


  • 2021-10-13 15:49

    도서관 서버 db에 접속 허가 받으셔서 sql로 통채로 받는게 빠를텐데요

     


전체 4,261
번호 카테고리 제목 작성자 작성일 추천 조회
4245 함수/공식
New raw 데이터를 이용하여 복수 조건에 해당하는 데이터 나열하기 문의 (3)
신동 | 2021.10.22 | 추천 0 | 조회 42
신동 2021.10.22 0 42
4244 함수/공식
New if를 사용하여 값 참조하게하기 (3)
현표 | 2021.10.22 | 추천 0 | 조회 36
현표 2021.10.22 0 36
4243 차트/그래프
New 음영 셀만 그래프에 수치가 표기 되거나 강조되게 하는 방법이 있을까요? 첨부파일 (1)
은하상회 | 2021.10.22 | 추천 0 | 조회 22
은하상회 2021.10.22 0 22
4242 VBA
New Sheet간 이미지 복사 방법이 있을까요?..(셀병합, 범위..) 첨부파일
tu1541 | 2021.10.22 | 추천 0 | 조회 35
tu1541 2021.10.22 0 35
4241 문서서식
New 기초) 자동필터에서 와일드카드 검색 질문드립니다 (2)
월마리아 | 2021.10.22 | 추천 0 | 조회 32
월마리아 2021.10.22 0 32
4240 VBA
New 피벗테이블 필터자동 변경 문의드려요 ㅠㅠ 첨부파일 (1)
Jun0211 | 2021.10.21 | 추천 0 | 조회 34
Jun0211 2021.10.21 0 34
4239 함수/공식
New 셀 2개의 데이타를 ㄹ합치는 법 (4) 답변완료
마운틴 | 2021.10.21 | 추천 0 | 조회 48
마운틴 2021.10.21 0 48
4238 VBA
New 필터링된 값 붙여넣기 첨부파일 (8) 답변완료
지연 | 2021.10.21 | 추천 0 | 조회 53
지연 2021.10.21 0 53
4237 함수/공식
New 엑셀 수식을 부탁드립니다. 첨부파일 (1)
워싱턴 | 2021.10.21 | 추천 0 | 조회 40
워싱턴 2021.10.21 0 40
4236 VBA
New 도와주세요 첨부파일 (1)
현아 | 2021.10.21 | 추천 0 | 조회 35
현아 2021.10.21 0 35
4235 함수/공식
New 업체명으로 된 DB에서 업체명 + ~월 등 문자가 추가되었을때 DB에서 찾아오는 함수 수식 (3) 답변완료
이수철 | 2021.10.21 | 추천 0 | 조회 43
이수철 2021.10.21 0 43
4234 함수/공식
New 로우데이터에서 특정값을 찾아 값이 있을 경우와 없을 경우 결과 값을 지정하여 도출하는 방법이 궁금합니다. (1)
mysoul**** | 2021.10.21 | 추천 0 | 조회 30
mysoul**** 2021.10.21 0 30
4233 함수/공식
New x,y,z로 이루어진 방정식 두 개를 '해 찾기' 기능으로 풀 수 있을까요? (6)
고대하라 | 2021.10.21 | 추천 0 | 조회 46
고대하라 2021.10.21 0 46
4232 기능/도구
New 셀선택시 설명 팝업 (6) 답변완료
HYODONG | 2021.10.21 | 추천 0 | 조회 36
HYODONG 2021.10.21 0 36
4231 피벗테이블
New 정규화에 대한 문의 첨부파일 (1)
광개토태왕 | 2021.10.21 | 추천 0 | 조회 31
광개토태왕 2021.10.21 0 31
4230 차트/그래프
New 원형 차트에 슬라이서 연결 시 표시 방법 문의 드립니다. (1)
이찬우 | 2021.10.21 | 추천 0 | 조회 25
이찬우 2021.10.21 0 25
4229 함수/공식
New 대량의 데이터를 가지고 있는 다른 시트에서 중복값찾기 (6) 답변완료
라운 | 2021.10.21 | 추천 0 | 조회 54
라운 2021.10.21 0 54
4228 VBA
New 시간이 겹치거나 겹친 시간에 동일 이름이 중복될 경우 찾을려면 어떻게 하면 될까요? (4)
셀라푸우 | 2021.10.20 | 추천 0 | 조회 42
셀라푸우 2021.10.20 0 42
4227 VBA
New 데이터 범위설정 매크로 수식 (2)
젬마 | 2021.10.20 | 추천 0 | 조회 53
젬마 2021.10.20 0 53
4226 피벗테이블
New 피벗테이블 구성 (2)
광개토태왕 | 2021.10.20 | 추천 0 | 조회 45
광개토태왕 2021.10.20 0 45
4225 VBA
New (초보..)vba 웹크롤링(selenium 사용) 문자를 읽어오지않아 문의드립니다!! (4)
윌터너 | 2021.10.20 | 추천 0 | 조회 37
윌터너 2021.10.20 0 37
4224 함수/공식
New 함수 자동입력?
흑형 | 2021.10.20 | 추천 0 | 조회 58
흑형 2021.10.20 0 58
4223 기능/도구
구글 스프레드시트 이미지 인쇄 문제 (1)
민 쌤 | 2021.10.20 | 추천 0 | 조회 31
민 쌤 2021.10.20 0 31
4222 파워쿼리/피벗
파워쿼리 입문입니다. 시트 합치는 방법 질문드립니다. 첨부파일 (2)
월마리아 | 2021.10.19 | 추천 0 | 조회 59
월마리아 2021.10.19 0 59
4221 함수/공식
공부용 일정표 관련해서 자동 생성 질문드립니다.
1234느린열차 | 2021.10.19 | 추천 0 | 조회 34
1234느린열차 2021.10.19 0 34
4220 함수/공식
변화되는 값 추적하기 첨부파일 (1)
아자사랑 | 2021.10.19 | 추천 0 | 조회 52
아자사랑 2021.10.19 0 52
4219 함수/공식
셀에 포함된 특정단어 추출 함수 첨부파일 (6) 답변완료
마운틴 | 2021.10.19 | 추천 0 | 조회 80
마운틴 2021.10.19 0 80
4218 피벗테이블
피벗테이블에서 열 (레이블) 상위 10% 필터링 방법 문의 첨부파일 (3)
김성현19 | 2021.10.19 | 추천 0 | 조회 39
김성현19 2021.10.19 0 39
4217 함수/공식
다중조건으로 매출 순위 구하기 첨부파일 (8) 답변완료
newstar | 2021.10.19 | 추천 0 | 조회 60
newstar 2021.10.19 0 60
4216 파워쿼리/피벗
Expression.Error: Table 형식의 값을 Binary 형식으로 변환할 수 없습니다 첨부파일 (3)
슝슝 | 2021.10.19 | 추천 0 | 조회 32
슝슝 2021.10.19 0 32