Scribbling for "Scripting"

前の記事のスクリプトで祝日データが取得できたので、VBAでそれを利用するサンプルとして日付が土日祝日かを判別する関数を紹介します。
前記事のスクリプトではタブ区切りテキスト形式で出力していましたが、今回はADOで利用しやすいCSV形式を利用します。
前記事のスクリプトをCSV出力に変更するためには、Else以降の部分を以下のものに差し替えます。

Else
  Set objFS = CreateObject("Scripting.FileSystemObject")
  Set objText = objFS.CreateTextFile(OUTPUTFILE)
  Set entrys = xmlDoc.selectNodes("//feed/entry")
    objText.Write("hdate,hname" & VbCr)
  For Each entry In entrys
    objText.Write(Replace(entry.selectSingleNode("gd:when").getAttribute("startTime"), "-", "/"))
    objText.Write("," & entry.selectSingleNode("title").text & VbCr)
  Next
  objText.Close
End If

すでに取得したデータがある場合は、エディタ等でタブを”,”に変更して、一行目に”hdate,hname”という行を追加してください。
例：
hdate,hname
2008/09/23,秋分の日
2008/03/20,春分の日
…

以下からがVBA関数のソースです。ADOを利用しているので実行にはMicrosoft ActiveX Data Objectsへの参照設定が必要です。
IsHoliday(date)で土日祝日のいずれかならばTrue、それ以外ならFalseを返します。祝日データの場所はそれぞれの環境に合わせて修正してください。

'祝日データの場所設定(ファイルのフォルダパスとファイル名)
Const HOLIDAYDATADIR = "c:¥calendar¥"
Const HOLIDAYDATAFILENAME = "holiday.txt"
'
'入力日が土日祝日かどうかを返す
Public Function IsHoliday(ByVal paramDate As Date) As Boolean
    Dim objRS As Object
    Dim objConn As Object
    '土日ならTrue
    If IsSaturdayorSunday(paramDate) = True Then
        IsHoliday = True
        Exit Function
    End If
    'CSVデータから祝日を検索してレコードがあればTrue
    Set objConn = New ADODB.Connection
    Set objRS = New Recordset
    objConn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & HOLIDAYDATADIR & ";"
    objRS.ActiveConnection = objConn
    objRS.Source = "SELECT * FROM " & HOLIDAYDATAFILENAME & " WHERE hdate LIKE '" & paramDate & "'"
    objRS.Open
    If objRS.EOF Then
        IsHoliday = False
    Else
        IsHoliday = True
    End If
    objRS.Close
    objConn.Close
End Function
'
'入力日が土日かどうかを返す
Public Function IsSaturdayorSunday(ByVal paramDate As Date) As Boolean
    Dim tmpWeekDay As Integer
    tmpWeekDay = Weekday(paramDate)
    If tmpWeekDay = vbSunday Or tmpWeekDay = vbSaturday Then
        IsSaturdayorSunday = True
    Else
        IsSaturdayorSunday = False
    End If
End Function