法人名から法人番号

Sub 法人番号()

'---------------------------------------

Dim CorpName As String

Dim i As Long

Dim arr As Variant

For i = 2 To ThisWorkbook.Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row

CorpName = Cells(i, 2)

On Error Resume Next

arr = CorpCode(URL_Encode(CorpName))

Cells(i, 3) = arr(4)

Cells(i, 4) = arr(9)

Cells(i, 5) = arr(12)

Cells(i, 6) = arr(13)

Cells(i, 7) = arr(14)

Next i

End Sub

Function CorpCode(CorpName As String) As String()

Dim objXMLHttp As Object

Dim tmp

Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")

objXMLHttp.Send

tmp = Split(Replace(objXMLHttp.responseText, """", ""), ",")

CorpCode = tmp

'---------------------------------------

End Function

Function URL_Encode(ByVal strOrg As String) As String

With CreateObject("ScriptControl")

.Language = "JScript"

URL_Encode = .CodeObject.encodeURI(strOrg)

End With

End Function

20220926追記

ExcelAPIで同じ事が出来る