先前寫過一篇「用 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」

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 這裡的「-」改為半形，或是把變成全行的符號改為半形。

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

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

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

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

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

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

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