エクセルVBAで実行時エラー438

質問

自宅のエクセル2019や、会社のMicrosoft365では問題なく動く下記のコードですが、エクセル2016のパソコンでは「実行時エラー '438':オブジェクトは、このプロパティまたはメソッドをサポートしていません。」となります。これはエクセルのバージョンの問題でしょうか？対応する方法はありませんか？

Sub sample()
Dim url As String
Dim zip As String
Dim httpReq As Object
Dim httpDoc As Object
Dim data As Object
Dim line As Object
Dim State As String
Dim city As String
Dim addressLine As String
'URL
url = "https://www.post.japanpost.jp/cgi-zip/zipcode.php?zip="
'郵便番号
zip = "1000001"

'HTTPリクエスト実行
Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
httpReq.Open "GET", url & zip, False
httpReq.Send

'「HTMLDocumentオブジェクト」にHTTPレスポンスを設定
Set httpDoc = CreateObject("htmlfile")
httpDoc.body.innerHTML = httpReq.responseText

'都道府県と市区を抜き出す
Set data = httpDoc.getElementsByClassName("data") 'ここでエラー
State = data(1).innerText
city = data(2).innerText
'町村を抜き出す
Set line = httpDoc.getElementsByClassName("line")
addressLine = line(0).innerText

'結果
MsgBox (State & city & addressLine)

'後片づけ
Set httpReq = Nothing
Set httpDoc = Nothing
End Sub

このコードは以下のサイトからコピペしたものです。

https://excel-vba.work/2023/03/27/%e3%80%90vba%e3%80%91%e9%83%b5%e4%be%bf%e7%95%aa%e5%8f%b7%e3%81%8b%e3%82%89%e4%bd%8f%e6%89%80%e3%82%92%e5%8f%96%e5%be%97%e3%81%99%e3%82%8b/

回答No.3

kkkkkm · ベストアンサー

> Dim divs As IHTMLElementCollectionより上の方はサイトを参考にして書こうと思ったら　....　と省略されており

記載したのが省略されている部分にあたります。

二つを合成して細かいところは考えずに実行したのが以下です。
(無駄な部分や後片付けで足りないところとかは追加変更してください)
書き忘れてましたが参照設定で
Microsoft HTML Object Library
を追加しておいてください。

Sub sample()
Dim url As String
Dim zip As String
Dim httpReq As Object
Dim httpDoc As Object
Dim data As Object
Dim line As Object
Dim State As String
Dim city As String
Dim addressLine As String
'URL
url = "https://www.post.japanpost.jp/cgi-zip/zipcode.php?zip="
'郵便番号
zip = "1000001"

'HTTPリクエスト実行
Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
httpReq.Open "GET", url & zip, False
httpReq.Send

'「HTMLDocumentオブジェクト」にHTTPレスポンスを設定
Set httpDoc = CreateObject("htmlfile")
httpDoc.body.innerHTML = httpReq.responseText
Dim htmlDoc As Object
Set htmlDoc = New HTMLDocument
htmlDoc.Write httpReq.responseText

Dim divs As IHTMLElementCollection
Dim tds As IHTMLElementCollection

Set divs = htmlDoc.getElementsByTagName("div")
Set tds = htmlDoc.getElementsByTagName("td")

Dim item As IHTMLElement
For Each item In tds
If item.getAttribute("className") = "data" Then
State = State & item.innerText
End If
Next
For Each item In divs
If item.getAttribute("className") = "data" Then
city = city & item.innerText
End If
Next
' '結果
Dim mAddress As String

mAddress = State & city
MsgBox Mid(mAddress, 10, InStr(mAddress, vbCrLf) - 10)
'後片づけ
Set httpReq = Nothing
Set httpDoc = Nothing
End Sub

お礼

すみません、そしてありがとうございます！
エラーになった端末でも無事動きました。
助かりました。お世話になりました。

回答No.2

kkkkkm

VBAでgetElementsByClassNameが使えないときの対処方法
https://blog.systemjp.net/entry/2020/04/06/140457

といった理由みたいですので(これ以外の解消方法が見つかりませんでした)

Dim divs As IHTMLElementCollectionより上の方はサイトを参考にしていただいて

こんな感じでいけるのではないでしょうか。

Dim divs As IHTMLElementCollection
Dim tds As IHTMLElementCollection

Set divs = htmlDoc.getElementsByTagName("div")
Set tds = htmlDoc.getElementsByTagName("td")

Dim item As IHTMLElement
For Each item In tds
If item.getAttribute("className") = "data" Then
State = State & item.innerText
End If
Next
For Each item In divs
If item.getAttribute("className") = "data" Then
city = city & item.innerText
End If
Next
' '結果
Dim mAddress As String

mAddress = State & city
MsgBox Mid(mAddress, 10, InStr(mAddress, vbCrLf) - 10)

State & cityのままだと最初に郵便番号が、最後に改行の後カタカナ(チヨダとか)が入るのでそこを除いてます。
Dimが散らかってますが、適当に位置を直してください。

お礼

ありがとうございます。
Dim divs As IHTMLElementCollectionより上の方はサイトを参考にして書こうと思ったら　....　と省略されており、わかりませんでした。すみません。

回答No.1

m5048172715

ちょっと調べてみたら、

エクセル2016PCのブラウザが古い？
VBAでgetElementsByClassNameを使えないときの対処方法
https://blog.systemjp.net/entry/2020/04/06/140457
という記事を見つけた。

お礼

ありがとうございます。
残念ながら、参照先URLをどう応用してよいかわかりませんでした。すみません。