You are currently viewing 用 Excel VBA批次取得網頁標題

用 Excel VBA批次取得網頁標題

先前寫過一篇「用 Excel批次取得網址 URL的網頁標題(title)」,不過隨著網頁、伺服器越來越安全,使用之前的語法可能會讓某些伺服器拒絕回應網頁標題,這時候可以參考下面的新版 VBA語法,加上一些參數騙過(?)伺服器回傳標題。

準備工具:Excel 2010以上的版本、一些舊語法會被拒絕的網址,例如網友提供的 TAAZE 讀冊生活網路書店

如果你只是要先嘗試,你可以先使用下面的範例網址:

https://www.taaze.tw/products/11100997593.html

https://www.taaze.tw/products/11101006457.html

https://www.taaze.tw/products/11101008118.html

在使用舊版語法時,TAAZE伺服器會回應網址被封鎖的訊息:「 The URL you requested has been blocked」

新版的語法,同樣的要使用到 EXCEL裡的 Visual Basic,如果你還沒有開啟,請參考這邊把開發人員的功能開啟。

1. 把要取得的網址貼在 A1:A3 的位置

2.點選上方標籤的「開發人員」> 「Visual Basic」

用 Excel VBA批次取得網頁標題 1

3. 在開啟的 Visual Basic視窗中,左邊的欄位點兩下「工作表1」,此時中間會開啟一個輸入指令碼的視窗

4. 貼入以下語法

Sub GetTitles()
Dim c As Range, url As String
For Each c In Range("A1:A3").Cells
url = Trim(c.Value)
If LCase(url) Like "https://*" Then
c.Offset(0, 1).Value = GetTitle(url)
End If
Next c
End Sub

Function GetTitle(sURL As String)
Dim title As String, res As String, pos1, pos2
Dim objHttp As Object
Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objHttp.Open "GET", sURL, False
objHttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/112.0.0.0 Safari/537.36 Edg/112.0.1722.58"
objHttp.Send ""

res = objHttp.ResponseText
pos1 = InStr(1, UCase(res), "<TITLE>")
pos2 = InStr(1, UCase(res), "</TITLE>")

title = "<not found>"
If pos1 > 0 And pos2 > 0 Then
pos1 = pos1 + Len("<TITLE>")
title = Mid(res, pos1, pos2 - pos1)
End If
GetTitle = title
End Function

ps. 如果你貼上語法時發生 title = Mid這行錯誤,請把 pos2 – pos1 這裡的「-」改為半形,或是把變成全行的符號改為半形。

用 Excel VBA批次取得網頁標題 2

5. 按一下工具列上的綠色「‣」執行,此時 B行就會開始填入這些網址的標題。

用 Excel VBA批次取得網頁標題 3

新版語法主要改變了以下兩點:

1. 改用「WinHttp.WinHttpRequest.5.1」物件,可以支援更多安全性的參數。

2. 增加 UserAgent,也就是中間很長的那串,目前這串是我從現行 Microsoft Edge中複製出來,可以自行修改。

備註:
1. A1:A3 上面紅色的指令碼,這裡是指你的網址填在哪幾個欄位,如果你有 20個網址那就是 A1:A20

2. https://* 上面藍色的指令碼,如果你的網址不是 https開頭,請把 s拿掉變成 http://*

3. 不要一次取得太多,譬如上百筆的網址,有可能因速度太快而讓網站伺服器拒絕回應

Sid

喜愛電腦資訊、歷史、古文明、宇宙、自然生態的主題。喜歡看卡通和科幻主題的電影,有長不大的心情。從事金融業相關工作,分享的技巧多來自工作上的各項應用實作。

發佈留言