【Excel】【VBA】内閣府のHPから祝日情報をダウンロードしてExcel出力

仕事で、祝日を取得する必要があったのでちょっとツールを作成

参照設定
VBAのコード
1. 共有:
2. いいね:

参照設定

Microsoft XML を参照設定する。

VBAのコード

XMLHTTPオブジェクトの機能で、内閣府のHPから祝日情報（CSVファイル）をダウンロードする。

ダウンロードしたファイルを、Excelシートに出力させる。

Sub 内閣府のHPから祝日情報をダウンロードしてExcel出力()

    '参照設定：
    Dim httpReq As XMLHTTP60
    Set httpReq = New XMLHTTP60
    Dim httpDoc As DOMDocument60
    
    
    httpReq.Open "GET", "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"
    httpReq.send
    
    Do While httpReq.readyState &lt; 4
        DoEvents
    Loop
    
    If httpReq.status = 200 Then
            Debug.Print StrConv(httpReq.responseBody, vbUnicode)
            Call writeExcel(StrConv(httpReq.responseBody, vbUnicode))
           
        Else
           Debug.Print "HTTP StatusCode:" &amp; httpReq.status &amp; ", HTTP StatusText:" &amp; httpReq.statusText
        End If
    
    
    Set httpReq = Nothing

End Sub

Sub writeExcel(ByVal responseBody As String)
    
    Dim CSVRec() As String
    Dim v() As String
    
    Dim i As Long, j As Long
    CSVRec = Split(responseBody, vbCrLf)
 
    For i = 0 To UBound(CSVRec)
        Debug.Print CSVRec(i)
        v = Split(CSVRec(i), ",")
        For j = 0 To UBound(v)
            ActiveSheet.Cells(i + 1, j + 1) = v(j)
        Next j
    Next i
    

End Sub

Sub 内閣府のHPから祝日情報をダウンロードしてExcel出力()

'参照設定：

Dim httpReq As XMLHTTP60

Set httpReq = New XMLHTTP60

Dim httpDoc As DOMDocument60

httpReq.Open "GET", "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"

httpReq.send

Do While httpReq.readyState < 4

DoEvents

Loop

If httpReq.status = 200 Then

Debug.Print StrConv(httpReq.responseBody, vbUnicode)

Call writeExcel(StrConv(httpReq.responseBody, vbUnicode))

Else

Debug.Print "HTTP StatusCode:" & httpReq.status & ", HTTP StatusText:" & httpReq.statusText

End If

Set httpReq = Nothing

End Sub

Sub writeExcel(ByVal responseBody As String)

Dim CSVRec() As String

Dim v() As String

Dim i As Long, j As Long

CSVRec = Split(responseBody, vbCrLf)

For i = 0 To UBound(CSVRec)

Debug.Print CSVRec(i)

v = Split(CSVRec(i), ",")

For j = 0 To UBound(v)

ActiveSheet.Cells(i + 1, j + 1) = v(j)

Next j

Next i

End Sub

 httpReq.Open "GET", "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"

1	httpReq.Open "GET", "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"

このURLを変更すれば、内閣府に限らず別のアップロード済みCSVファイルを取得しExcelシートに出力できる。

参照設定

VBAのコード

共有:

いいね:

コメント