Hi, Andy,

我找到了其他類似的 URL of WebSite "https://www.pinterest.com/oxxostudio/outdoor/" 允許存取 請問可以教我 如何抓取 網頁上的圖片 Learn step by step 如同 Excel VBA 的眉眉角角Day29?

希望 學習

1. 連到首頁，如何檢視， 解析網頁 第一頁內容的JPG， 單獨取出路徑後開啟，確認檔案位置正確

2. 套用例 Call GetISSUU("https://www.pinterest.com/oxxostudio/outdoor/")
   WinHttpReq.Open "GET", ISSUU_URL, False
   WinHttpReq.send

Sub doGetISSUU()
Call GetISSUU("https://www.pinterest.com/oxxostudio/outdoor/")
MsgBox "Done!"
End Sub

3. 如何 修改 子程式，用來讀取網頁內容，並取得相關變數，然後呼叫下載的副程式繼續處理下子事宜：

Function GetISSUU(ISSUU_URL As String)
Dim myURL As String
Dim WinHttpReq As Object
Dim strBody As String
Dim strDocumentId As String, iPageCount As Integer, strTitle As String
Dim strPath As String
Dim strFileName As String
strPath = "D:\temp\ISSUU"
Dim iDocumentId_Start As Integer, iDocumentId_End As Integer
Dim iPageCount_Start As Integer, iPageCount_End As Integer
Dim iTitle_Start As Integer, iTitle_End As Integer

'使用Microsoft.XMLHTTP物件，傳送網址(ISSUU_URL)給對方，然後取回(GET)回傳資料
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
'WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.Open "GET", ISSUU_URL, False
WinHttpReq.send
    '將回傳資料放到strBody變數
strBody = WinHttpReq.responseText
    '確認回傳的狀態是否正常，200代表正常
If WinHttpReq.Status = 200 Then
    'Debug.Print strBody
            '用InStr取出所需變數
    iDocumentId_Start = InStr(strBody, """documentId"":") + 14
    iDocumentId_End = InStr(Mid(strBody, iDocumentId_Start, Len(strBody)), ",") + iDocumentId_Start
    iPageCount_Start = InStr(strBody, """pageCount"":") + 12
    iPageCount_End = InStr(Mid(strBody, iPageCount_Start, Len(strBody)), ",") + iPageCount_Start
    
    iTitle_Start = InStr(strBody, """title"":") + 9
    iTitle_End = InStr(Mid(strBody, iTitle_Start, Len(strBody)), ",") + iTitle_Start
    strDocumentId = Mid(strBody, iDocumentId_Start, iDocumentId_End - iDocumentId_Start - 2)
    iPageCount = Mid(strBody, iPageCount_Start, iPageCount_End - iPageCount_Start - 1)
    strTitle = Mid(strBody, iTitle_Start, iTitle_End - iTitle_Start - 2)
        'Debug.Print strTitle
End If

'檔名以目前時間取名
strFileName = Format(Now, "yyyymmdd-hhmmss")
     Debug.Print strFileName & ": " & strTitle
    '呼叫下載副程式
Call Download_ISSUU_File(strDocumentId, iPageCount, strPath, strFileName)
    '執行PDFCreator內建的Images2PDF子程式，將JPEG檔包成PDF檔
Call RunCmd("""" & Environ("ProgramFiles") & "\PDFCreator\Images2PDF\Images2PDFC.exe" & """" & " /i """ & strPath & "\" & strFileName & "\*.jpg"" /e """      & strPath & "\" & strFileName & ".pdf""", True, 1)

End Function

'' 下載副程式，用來批次下載每頁圖片檔案：
Function Download_ISSUU_File(strDocumentId As String, iPageCount As Integer, strSavePath As String, strFileName As String)
'strDocumentId ISSUU的書本ID
'iPageCount 頁數
'strSavePath 存放路徑
'strFileName 檔案名稱

Dim myURL As String
Dim WinHttpReq As Object
strFileName = Replace(strFileName, "/", "")

MkDir (strSavePath & "\" & strFileName)

'下載每頁圖片檔
For i = 1 To iPageCount
    myURL = "http://image.issuu.com/" & strDocumentId & "/jpg/page_" & Format(i, "0") & ".jpg"

    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    'WinHttpReq.Open "GET", myURL, False, "username", "password"
    WinHttpReq.Open "GET", myURL, False
    WinHttpReq.send

    	If WinHttpReq.Status = 200 Then
    		Set oStream = CreateObject("ADODB.Stream")
	        oStream.Open
	        oStream.Type = 1
	        oStream.Write WinHttpReq.responseBody
                   oStream.SaveToFile strSavePath & "\" & strFileName & "\" & strFileName & "_" & Format(i, "000") & ".jpg", 2     ' 1 = 不複寫, 2 = 複寫
	        oStream.Close
	End If
Next

End Function

'' 下載下來的每張圖片檔

B. Rgds.,
Robert Chen