テスト26

Private Sub Workbook_Open()

'祝休日からの営業日判定
'--------------------
'事前に参照設定を行う
'Microsoft XML, v3.0
'---------------------
'https://www.apibank.jp/ApiBank/api/detail?api_no=599&api_type=Iを参照
'祝日判定WebAPI
'内閣府のwebを元に祝日チェック(日本特有の官公庁や東証の休日にも対応)を行うwebAPI
'-----------------------

Dim D As Variant         '日付用
Dim apiUrL As String    'apiのURL
Dim apiUrL2 As String   'apiのURL
Dim day As Variant
Dim HttpReq As Object   'Httpリクエストオブジェクト用
Dim i As Long           'カウンタ
Dim j As Long           '営業日
Dim k As Long           '通常日数

Application.ScreenUpdating = False

On Error GoTo ErExit

apiUrL = "http://s-proj.com/utils/checkHoliday.php?kind=h&date="

D = Replace(Date, "/", "")

i = 1

Set HttpReq = CreateObject("MSXML2.XMLHTTP")

apiUrL2 = apiUrL

D = Date

k = 0
'-----------------------------------------
For i = 1 To 21

    D = Replace(D, "/", "")

    apiUrL2 = apiUrL & D

    HttpReq.Open "GET", apiUrL2, False

    HttpReq.Send (Null)

    '戻り値（祝休日の場合holiday、それ以外はelseを返す)
    If HttpReq.responseText = "else" Then

        '営業日計算で指定の日数に達した条件ごとに入力
        If j = 1 Then

            ThisWorkbook.Sheets("Sheet7").Cells(4, 2).Value = Format(D, "0000/00/00")

        ElseIf j = 5 Then

            ThisWorkbook.Sheets("Sheet7").Cells(5, 2).Value = Format(D, "0000/00/00")

        ElseIf j = 10 Then

            ThisWorkbook.Sheets("Sheet7").Cells(6, 2).Value = Format(D, "0000/00/00")

        End If

        j = j + 1   '営業日日数加算
        k = k + 1   '通常日数加算

    Else

        '通常日数加算
        k = k + 1

    End If

    D = Date + k

    If k = 21 Then

        ThisWorkbook.Sheets("Sheet7").Cells(7, 2).Value = D

    End If

Next i
'-----------------------------------------

Set HttpReq = Nothing

Application.ScreenUpdating = True

Exit Sub

'----------------------
ErExit:

MsgBox "サーバーに接続できなかったので、手入力でお願いします。", vbCritical

Set HttpReq = Nothing

Application.ScreenUpdating = True

End Sub