テスト27

Private Sub Workbook_Open()

'営業日判定
'--------------------
'事前に参照設定を行う
'Microsoft XML, v3.0
'---------------------
'https://www.apibank.jp/ApiBank/api/detail?api_no=599&api_type=Iを参照
'http://s-proj.com/utils/holiday.htmlを参照
'祝日判定WebAPI
'内閣府のwebを元に祝日チェック(日本特有の官公庁や東証の休日にも対応)を行うwebAPI
'gov:官公庁（12/29-1/3が休み）
'-----------------------

Dim D As Variant
Dim apiUrL() As Variant

On Error GoTo ErExit

ReDim Preserve apiUrL(1 To 3)

Application.ScreenUpdating = False

'無色
ThisWorkbook.Sheets("Sheet7").Range("B4:B7").Interior.ColorIndex = 0
D = Replace(Date, "/", "")
'"http://s-proj.com/utils/getBusinessDay.php?kind=next5&date_format=yyyy/mm/dd&date=" &　D　& "opt=gov"
apiUrL(1) = "http://s-proj.com/utils/getBusinessDay.php?kind=next&date_format=yyyy/mm/dd&date=" & D & "&opt=gov"
apiUrL(2) = "http://s-proj.com/utils/getBusinessDay.php?kind=next5&date_format=yyyy/mm/dd&date=" & D & "&opt=gov"
apiUrL(3) = "http://s-proj.com/utils/getBusinessDay.php?kind=next10&date_format=yyyy/mm/dd&date=" & D & "&opt=gov"

Set HttpReq = CreateObject("MSXML2.XMLHTTP")

For i = 1 To 3

    HttpReq.Open "GET", apiUrL(i), False

    HttpReq.Send (Null)

    ThisWorkbook.Sheets("Sheet7").Cells(i + 3, 2).Value = HttpReq.responseText

Next i

D = Date + 21

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

Application.ScreenUpdating = True

Exit Sub

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

'削除
ThisWorkbook.Sheets("Sheet7").Range("B4:B7").ClearContents

'黄色
ThisWorkbook.Sheets("Sheet7").Range("B4:B7").Interior.ColorIndex = 27

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

Set HttpReq = Nothing

Application.ScreenUpdating = True

End Sub