[VBA] 네이버 이미지 크롤링 (윤자동 채널)

https://www.youtube.com/watch?v=Fs1o3jaozdo 

몇일전 다잡님이 올려주신 코드로 일부 수정하여 올려본다.

Option Explicit
Dim datetype&
Dim dateshort$
Dim datestart
Dim dateend
Dim Diff_date$, DateCal&

Private Sub DownloadBtn_Click()
    Dim strUrl$, strPath$, strTitle
    Dim strKword$, strRequest$
    Dim imgFolder$, select_Date$
    Dim Json As Object
    Dim Item As Object
    Dim i&, N&, Cnt&, pic_down_Cnt&
    
    DownloadBtn.Visible = False
   
    strKword = Me.keyword
    imgFolder = Me.imgPath
    DateCal = DateDiff("d", Me.year1 & "-" & Me.month1 & "-" & Me.day1, Date)
 
    FileList = "네이버에서 [" & strKword & "] 검색중 . . ."
    Cnt = Me.PicCnt / 50
    N = 1
    
    Do Until pic_down_Cnt >= Me.PicCnt
    
        strUrl = "https://s.search.naver.com/p/c/image/search.naver?where=image&mode=&rev=44&section=image" & _
                 "&query=" & strKword & "&ac=0&aq=0&spq=1&nx_search_query=" & strKword & _
                 "&nx_and_query=&nx_sub_query=&nx_search_hlquery=&nx_search_fasquery=" & _
                 "&res_fr=0&res_to=0&color=&datetype=" & datetype & "&startdate=" & datestart & "&enddate=" & dateend & "&nso=so:r,a:all,p:" & dateshort & _
                 "&json_type=6&optStr=d&ccl=0&x_image=&display=100&abt=&pq=&start=" & N
                 
        strRequest = Fn.Request(strUrl)
        strRequest = Replace(Replace(strRequest, "(", ""), ")", "")
        
        Set Json = JsonConverter.ParseJson(strRequest)
        Set Item = Json("items")
        
        FileList = Me.PicCnt & "개의 이미지를 다운로드합니다"
        If pic_down_Cnt > Me.PicCnt Then Exit Do
        
        For i = 1 To Item.Count
        pic_down_Cnt = pic_down_Cnt + 1
        
        On Error Resume Next
            strPath = Fn.DECODEURL(Item(i)("originalUrl"))
            strTitle = Fn.DECODEURL(Item(i)("title"))
         
            Fn.downloadFile strPath, imgFolder & "\" & pic_down_Cnt & ".jpg"
            strPath = imgFolder & "\" & pic_down_Cnt & ".jpg"
         
            Me.SetProgress pic_down_Cnt / Me.PicCnt, pic_down_Cnt & " / " & _
            Me.PicCnt & " (" & Format(pic_down_Cnt / Me.PicCnt, "0.00%") & ")"
        
            Me.FileList = "[" & pic_down_Cnt & "] " & strTitle
            Me.Image1.Picture = LoadPicture(strPath)

        On Error GoTo 0
        
        Next i
        N = N + 50
        DoEvents
    Loop
        FileList = "다운로드가 완료되었습니다."
        DownloadBtn.Visible = True
        Me.year1.Enabled = True
        Me.month1.Enabled = True
        Me.day1.Enabled = True
        Me.Obt1 = False: Me.Obt2 = False: Me.Obt3 = False: Me.Obt4 = False: Me.Obt5 = False
End Sub

Private Sub selected_Folder_Click()
    
    With Application.FileDialog(msoFileDialogFolderPicker)  '= 폴더선택
             .Show
            
         If .SelectedItems.Count = 0 Then
            Exit Sub
         Else
            Me.imgPath = .SelectedItems(1) & "\"
         End If
    End With

End Sub

Private Sub FromTo_Click()
    Me.year1.Enabled = False
    Me.month1.Enabled = False
    Me.day1.Enabled = False
    datetype = 6: datestart = Me.year1 & Me.month1 & Me.day1: dateend = Me.year2 & Me.month2 & Me.day2
    dateshort = "from" & Me.year1 & Me.month1 & Me.day1 & "to" & Me.year2 & Me.month2 & Me.day2
    Call DownloadBtn_Click
End Sub

Private Sub DateAll_Click()
    
    Me.year1.Enabled = False
    Me.month1.Enabled = False
    Me.day1.Enabled = False
    datetype = 0: datestart = 0: dateend = 0
    dateshort = "all"
    Me.year1 = Year(Date): Me.month1 = Month(Date): Me.day1 = Day(Date):
    Call DownloadBtn_Click
End Sub
Private Sub Obt1_Click()
    If Me.Obt1 = True Then datetype = 1: DateCal = 0: Diff_date = DateAdd("d", -1, Date): Me.year1 = Year(Diff_date): Me.month1 = Month(Diff_date): Me.day1 = Day(Diff_date): dateshort = "1d"
End Sub

Private Sub Obt2_Click()
    If Me.Obt2 = True Then datetype = 1: DateCal = 0: Diff_date = DateAdd("d", -7, Date): Me.year1 = Year(Diff_date): Me.month1 = Month(Diff_date): Me.day1 = Day(Diff_date): dateshort = "1w"
End Sub
Private Sub Obt3_Click()
    If Me.Obt3 = True Then datetype = 2: DateCal = 0: Diff_date = DateAdd("m", -1, Date): Me.year1 = Year(Diff_date): Me.month1 = Month(Diff_date): Me.day1 = Day(Diff_date): dateshort = "1m"
End Sub
Private Sub Obt8_Click()
    If Me.Obt8 = True Then datetype = 8: DateCal = 0: Diff_date = DateAdd("m", -3, Date): Me.year1 = Year(Diff_date): Me.month1 = Month(Diff_date): Me.day1 = Day(Diff_date): dateshort = "3m"
End Sub
Private Sub Obt4_Click()
    If Me.Obt4 = True Then datetype = 4: DateCal = 0: Diff_date = DateAdd("m", -6, Date): Me.year1 = Year(Diff_date): Me.month1 = Month(Diff_date): Me.day1 = Day(Diff_date): dateshort = "6m"
End Sub
Private Sub Obt5_Click()
    If Me.Obt5 = True Then datetype = 5: DateCal = 0: Diff_date = DateAdd("yyyy", -1, Date): Me.year1 = Year(Diff_date): Me.month1 = Month(Diff_date): Me.day1 = Day(Diff_date): dateshort = "1y"
End Sub

Private Sub UserForm_Initialize()
    
    Dim imgFolder$: imgFolder = "C:\네이버이미지크롤링"
    Dim i&
    
    Me.StartUpPosition = 0
    Me.Top = 250
    Me.Left = 400
    
    For i = Year(Date) To Year(Date) - 10 Step -1
        Me.year1.AddItem i
    Next i
        Me.year1 = Year(Date)
    For i = 1 To 12
        Me.month1.AddItem i
    Next i
        If Len(Dir(imgFolder & "\", vbDirectory)) = 0 Then MkDir imgFolder
        Me.imgPath = imgFolder
        Me.year1 = Year(Date)
        Me.year2 = Year(Date)
        Me.month1 = Month(Date)
        Me.month2 = Month(Date)
        Me.day1 = Day(Date)
        Me.day2 = Day(Date)
    
End Sub
Private Sub month1_Change()
    Dim i&

    For i = 0 To 30
        If Month(DateSerial(year1, month1, 1 + i)) <> Val(month1) Then Exit For
        Me.day1.AddItem i + 1
     Next i
End Sub

Function SetProgress(per, msg)
    Me.progressFront.Width = Me.progressBack.Width * per
    Me.progressMsg.Caption = msg
    DoEvents
End Function

코드 자체가 다잡님 코드에서 온거라 본인의 설명보다는 다잡님 강의를 정독해보는 것을 추천한다.

네이버이미지크롤링(22.06.13)).xlsm

0.08MB