VBA / 抓取網路JSON資料

修改成使用XMLHTTP 物件來抓取網頁資料，而不是先將資料存在儲存格中 · 使用XMLHTTP 物件必須額外引入Microsoft HTML Object Library · Early Binding 和 ... Skiptocontent 有什麼趣味？紀錄自己生活的趣味 Postauthor:莊幸諺 Postpublished:2021-05-25 Postcategory:Excel&VBA 歡迎分享VBA無法像JavaScript等程式有現成的編譯函數 所以處理的方式會有點瑣碎，資料必須進行多次的切割 我參考了之前東吳VBA課程吳老師的教學範例 修改成使用XMLHTTP物件來抓取網頁資料，而不是先將資料存在儲存格中 這是因為一個儲存格中僅能顯示32,767個字元，如果資料量太多就無法先存在儲存格 只能將資料存在變數之中，再透過字串分割處理來留下需要的資料 使用XMLHTTP物件必須額外引入MicrosoftHTMLObjectLibrary 引用物件的方式分為2種 EarlyBinding和LateBinding EarlyBinding就是先在工具->設定引用項目->勾選 之後用New物件名稱來建立物件 如果要控制IE或者Windows系統和檔案，也同樣需要引入對應的物件     LateBinding則是透過CreateObject(物件名稱)   用來練習的檔案都來自政府資料開放平臺 但是這個平臺只是匯集政府各單位的資料 所以不同的單位可能會有不一樣的Json內容 有些是很單純的資料， 有些還會有很多說明資訊，而資料是其中一個屬性內容，例如以下的資料   所以必須針對不同資料型態適當修改程式 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 '設定網址 ConstURlAsString="https://data.epa.gov.tw/api/v1/aqx_p_432?limit=1000&api_key=9be7b239-557b-4c10-9775-78cadfc555e9&format=json" '分割單筆json資料{"key1":"value1",....} SubJSON_Split_Range(S,k) '處理資料 'Debug.Print"S1-"&S S=Replace(S,"""","") 'Debug.Print"S2-"&S S=Replace(S,"","") 'Debug.Print"S3-"&S '分割單筆json資料為key1:value1...... arr=Split(Mid(S,2,Len(S)-2),",")'第一筆跳過{開始取字串第二筆之後跳過,得到key:value格式的字串陣列 'Debug.Print"arr(0)-"&arr(0) c=1 Fori=0ToUBound(arr) 'Debug.Print"arr(i)"&arr(i) '分割key1:value1 arr2=Split(Trim(arr(i)),":") 'Debug.Print"arr2(0)"&arr2(0) 'Debug.Print"arr2(1)"&arr2(1) Ifk=1Then 'Debug.Print"arr2(0)-"&arr2(0) 'Debug.Print"arr2(1)-"&arr2(1) Cells(k,c)=arr2(0) Cells(k+1,c)=arr2(1) Else:Cells(k+1,c)=arr2(1) EndIf c=c+1 Next EndSub '透過XMLHTTP抓取網頁資料 SubxmlHttp() Application.ScreenUpdating=False '刪除舊資料 Sheets(1).Select Cells.Select Selection.ClearContents Range("A1").Select '設定XMLHTTP物件 DimxmlHttpAsObject SetxmlHttp=CreateObject("MSXML2.ServerXMLHTTP.6.0") xmlHttp.Open"GET",URl,False xmlHttp.setRequestHeader"Content-Type","application/json;charset=utf-8" xmlHttp.setRequestHeader"Cache-Control","no-cache" xmlHttp.setRequestHeader"Pragma","no-cache" xmlHttp.setRequestHeader"User-Agent","Mozilla/5.0(WindowsNT10.0;Win64;x64)AppleWebKit/537.36(KHTML,likeGecko)Chrome/90.0.4430.212Safari/537.36" xmlHttp.send '儲存格內容的長度(文字) '32,767個字元。

在一個儲存格中僅能顯示1,024個字元；在資料編輯列顯示全部32,767個字元。

'XMLHttpResponse 'T=xmlHttp.getResponseHeader("content-length")'資料字元數 'P=Len(xmlHttp.ResponseText)'資料內容長度 S=xmlHttp.ResponseText'回傳資料內容 '連線沒問題才處理 IfxmlHttp.readyState=4Then IfxmlHttp.Status=200Then '處理抓回來的資料要依據實際資料進行調整 startVal=InStr(1,S,""""&"records"&"""",vbTextCompare)'"records" startVal=InStr(startVal,S,"[",vbTextCompare)'[ endVal=InStr(startVal,S,"]",vbTextCompare)'] strDiv=Mid(S,startVal,(endVal-startVal)+1)'從"records"後取出[{...}] 'Debug.Print"strDiv-"&strDiv 'Debug.Print"Mid(strDiv,2,Len(strDiv)-2"&Mid(strDiv,2,Len(strDiv)-2)'從[...]取出{..).{..}- arr=Split(Mid(strDiv,2,Len(strDiv)-2),"}")'>split}最後一個分割會沒有資料 k=1 'Debug.Print"UBound(arr)-"&UBound(arr) Fori=0ToUBound(arr)'回傳陣列的index數 'Debug.Print"arr(i)-"&arr(i) Ifarr(i)<>""Then'最後一筆分割沒資料 CallJSON_Split_Range(arr(i),k)'再分割 EndIf k=k+1 Next EndIf EndIf MsgBox("輸出完成") Application.ScreenUpdating=True EndSub   完成的樣子   後來在網路上發現可以從excel直接讀取Json檔 Excel2016從資料→新查詢→其他來源→從Web 網路的教學在從檔案裡就有Json的選項，應該是2016之後的版本   →貼入Json來源，就可以將資料讀進ExcelPowerQuery進行處理   因為抓取的Json檔，將資料放在名稱為records屬性裡 所以點擊records的List 會出現所有records的資料   在清單案右鍵→到表格 或者左上的按鈕也一樣   會出現資料欄位，因為是要抓所有資料，就直接按確定 如果要選擇部分欄位的話，可以按載入更多顯示所有欄位   這邊用預設的”無”就可以了 選其他的分隔符號都無法成功建立表格   成功建立表格   按關閉並載入就會回到Excel   載入的資料會套用表格，並開啟篩選的功能   後記 在過程發生了2個情況 第1個情況是前面有提到的有的Json檔可以直接在網頁開啟，有的卻會直接下載 後者無法在VBAXMLHTTP抓取資料，經過Google大神的開示 這是網頁HTTPresponseheader之中Content-Disposition的關係 如果Content-Disposition屬性值為：attachment，就會下載成附件 屬性值如果是inline（默认值)就會以網頁形式顯示 例如使用Chrome外掛HeaderEditor修改之後，就能夠直接顯示在瀏覽器頁面 (用xmlHttp.getResponseHeader(“Content-Disposition”)得到的值仍然是attachment) 所以在XMLHTTP增加了xmlHttp.setRequestHeader“Content-Disposition”,“inline” 這樣就能夠抓取資料 備註：後來更新Excel之後，PowerQuery的”從Web”也可以在”進階”設定Header的參數   備註2：這個方式跟POWERBI一樣，使用了PowerQueryM語言建立查詢   第2個情況是在其他電腦利用ExcelPowerQuery建立連線時 會出現”要求已經中止:無法建立SSL/TLS的安全通道” Google大神表示可能是.Net的問題 後來我後來發現兩臺電腦Excel執行”從Web”設定連結的介面不太一樣，有問題的沒有”基礎”、”進階”的選項 所以猜想可能是ExcelPowerQuery的問題   執行Windows跟Offiec更新(在進階選項要開啟”收到其他Microsoft產品的更新”) 確實.Net跟Excel2016都有更新檔 更新之後就能正常連線了 Tags:JavaScript,VBA Readmorearticles PreviousPostVBA/自訂函數產生GooglecalendarrenderlinkNextPostVBA/透過ExcelVBA下載在GoogleCharts製作QrCode的圖檔 BuyMeaCoffee 站內搜尋 文章行事曆 2022年6月 一 二 三 四 五 六 日  12345 6789101112 13141516171819 20212223242526 27282930   «5月     文章分類 君子不器(92) App(4) Google-GCP&GAS(28) JavaScript(3) Office(42) Excel&VBA(30) Outlook&VBA(1) PowerBI(4) Word&VBA(6) Python(2) Web(1) WordPress(22) 我的相機(40) CanonNikon(6) KonicaMinolta(8) OlympusFujifilm(5) Others(9) PentaxRicoh(11) 自學玩玩(27) 江湖一點訣(13) 課程筆記(8) 軟體使用紀錄(6) 隨手寫寫(10) 近期文章君子不器Gg/如何製作GoogleMeet背景以及合併列印文字網站/莊生趣味tricohobby重生與分身Gg/如何在Gmail撰寫Html內容的信件VBA/在Outlook使用VBA大量寄信我的相機Other/P67轉PKPentaxRicoh/PentaxESPIO928Others/PanasonicDMC-ZS3Others/CasioQV-R40自學玩玩Gg/如何製作GoogleMeet背景以及合併列印文字Gg/如何在Gmail撰寫Html內容的信件SoftWave/使用PowerPoint2019錄製視訊旁白VBA/透過ExcelVBA下載在GoogleCharts製作QrCode的圖檔版本2隨手寫寫儀式感白日夢之必要腦科學-大腦演化機制腦科學-神經系統的演變 Gotomobileversion