VBScriptで日付処理 そにょ３･･･

日付の処理だけ、某Format関数を模してみた。･･･あくまで暫定版。
限られた指定方法で、要素を並べ替えられる程度しか機能しないが、
新たに曜日を要素として取得可能になっている。

書式)
   iDTw({tDate}, {tNow}, {sFormat}, {dSplitter}, {tSplitter}, {dtSeparator}, Control)    

      {tDate}        日付情報(時間を含まない)  Date()ないし等価
      {tNow}         時間情報                  Now()ないし等価
      {sFormat}      OutPutFormat              (Default - "Y/M/D H:N:S")
      {dSplitter}    DateSplitString           (Normal - "/")
      {tSplitter}    TimeSplitString           (Normal - ":")
      {dtSeparater}  Date/Time SepaleteString  (Default - " ")
      Control        0 文字列 / 1 配列化       (Default - 0)
      

{sFormat}に対し、半角英大文字の、"YMD" で 日付部分を 
"W"で曜日を "HN" で 時分を "S" で秒を、それぞれ任意の位置に配置できます。

★オマケ
   "S HNS YMD [W] HN"    
のようなデタラメな呼び出しも可能^_^;


曜日取得処理 GetWeekDay
装飾も含めて好きなように曜日文字列を取得したいが為だけに作成したモノ。
単なる曜日取得と異なり、逆引き検索や対応データへの変換など、
パラメータの適用次第で応用の幅を広げられるようになっている。
また、iDTw を使う場合、変数 strWeekday をPublicで宣言し、
この関数(の結果)を事前に代入しておくコトが必須となる。
なんだか、海外のライブラリ使ってるみたいで使いデ悪くて、お蔵入りさせてたブツではあるがw

書式)
   GetWeekday(YMD, wFormat, WeekdaysString, nDepth)

　　　YMD               － 日付を指定 (Date関数と等価値)
　　　wFormat          － 戻り値に対する装飾を指定  例) " [ W ] "
　　　WeekdaysString   － 曜日のリストを入力 ･･･リストの構成はサンプル参照のことw    
　　　nDepth           － リスト中の次元の深さを指定 (0～)


lArray や inArrays は、これらの為に用意したモノとも云える･･･

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        'GetWeekDay & iDTw & lArray & inArrays     
        '- Created by LazwardFox -     
         
        ' スクリプトライブラリの一部     
             
        ' Release 20090228 1639     
         
    '***** ↓↓↓ Decralations ↓↓↓ ******************************************************     
        Const strWeekdays = "1:月:MON:Mon:Monday,2:火:TUE:Tue:Tuesday,3:水:WED:Wed:Wednesday,4:木:THU:Thu:Thursday,5:金:FRI:Fri:Friday,6:土:SAT:Sat:Saturday,7:日:SUN:Sun:Sunday"     
        Const vbWq = """"     
        Public strWeekday     
         
        Dim varNow, VarDate, sDa, sDb, sDc, sDd, sDe, testResult     
         
         
    '***** ↓↓↓Main(Test)Routine↓↓↓ ***************************************************     
        varNow = Now()     
        varDate = Date()     
         
        'Function GetWeekday(YMD,wFormat,WeekdaysString,nDepth)     
        strWeekday = GetWeekday(varDate,,strWeekdays,3)     
         
        sDa = iDTw(varDate,varNow,"YMD [W] HN","/",":",,0) '文字列テスト     
        sDb = iDTw(varDate,varNow,"YMD",,,,0)              '文字列テスト     
        sDc = iDTw(,,"YMD*[W]*HNS",,,"*",1)                '配列テスト     
        sDd = iDTw(,,"YMDWHNS","",""," ",0)                'スプリッタ無しテスト     
        sDe = iDTw(,,"YMD [ W ] HNS","",""," ",0)          'スプリッタ無しテスト     
         
        testResult = "iDTw(" & "varDate,varNow," & vbWq & "YMD [W] HN" & vbWq & "," & vbWq & "/" & vbWq & "," & vbWq & ":" & vbWq & ",,0) - ＜String YMD[W]HN＞ - >>> " & sDa & vbTab & vbCrLf _     
        & "iDTw(" & "varDate,varNow," & vbWq & "YMD" & vbWq & ",,,,0) - ＜String YMD Only＞ - >>> " & sDb & vbTab & vbCrLf _     
        & "iDTw(" & ",," & vbWq & "YMD*[W]*HNS" & vbWq & ",,," & vbWq & "*" & vbWq & ",1) - ＜Array iDTw(1)＞ - >>> " & sDc(1) & vbTab & vbCrLf _     
        & "iDTw(" & ",," & vbWq & "YMDWHNS" & vbWq & "," & vbWq & vbWq & "," & vbWq & vbWq & "," & vbWq & " " & vbWq & ",0) - ＜String NoSplitter＞ - >>> " & sDd & vbTab & vbCrLf _     
        & "iDTw(" & ",," & vbWq & "YMD [ W ] HNS" & vbWq & "," & vbWq & vbWq & "," & vbWq & vbWq & "," & vbWq & " " & vbWq & ",0) - ＜String Full＞ - >>>" & sDe & vbTab     
         
        msgbox testResult,,"Test"     
         
    '***** ↓↓↓Functions↓↓↓ ***********************************************************     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'GetWeekDay - 曜日文字列配列化及び取得     
        '- Created by LazwardFox -     
             
            ' Update 20090228 1403 inArraysの新版向けに変更     
            ' Update 20090228 0855 配列化関数をinArraysに差し替え     
            ' Update 20090223 1544     
            ' Release 20090223      
            ' Develop 20090223 1018     
         
            ' GetWeekday(     
            '             YMD   － 日付を指定 (Date関数と等価値)     
            '            ,wFormat  － 戻り値に対する装飾を指定  例) " [ W ] "     
            '            ,WeekdaysString   － 曜日のリストを入力     
            '            ,nDepth   － リスト中の次元の深さを指定 (0～)     
            '            )     
         
        Function GetWeekday(YMD,wFormat,WeekdaysString,nDepth)     
            Dim arsWeekdays,arWeekdays     
            If TypeName(WeekdaysString) = "Error" Then     
            ElseIf VarType(arWeekdays) = vbArray Then     
            Else     
                inArrays WeekdaysString,",:",arWeekdays     
            End If     
            If TypeName(wFormat) = "Error" Then     
                GetWeekday = arWeekdays(Weekday(YMD,2) - 1)(nDepth)     
            Else     
                GetWeekday = Replace(wFormat,"W",arWeekdays(Weekday(YMD,2) - 1)(nDepth))     
            End If     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iDTw - 日時(曜日)文字列 ないし 日/曜日/時 配列取得 for VBScript     
        '- Created by LazwardFox -     
         
            ' Update 20090228 1403 inArraysの新版向けに変更     
            ' Release 20090223 1413 iDTから改良     
         
            ' Control以外のパラメータを省略可     
         
            ' iDTw (     
            '      {tDate}日付情報(時間を含まない)Date()ないし等価     
            '     ,{tNow}時間情報Now()ないし等価     
            '     ,{sFormat}OutPutFormat(Default - "YMD HNS")     
            '     ,{dSplitter}DateSplitString (Normal - "/")     
            '     ,{tSplitter}TimeSplitString (Normal - ":")     
            '     ,{dtSeparater}Date/Time SepaleteString (Default - " ")     
            '     ,Control0 文字列 / 1 配列化  (Default - 0)     
            '     )     
         
            '記述例) iDTw(,,,,,0)－ 現在の年月日／時分秒を配列で取得     
            'iDTw(,,"YMD*W*HNS",,"*",0)－ 現在の年月日／曜日／時分秒を配列で取得     
         
            '曜日を取得する場合、事前に 変数strWeekdayをPublicで宣言し、     
            'GetWeekDay を実行、代入しておく必要があります。     
         
        Function iDTw(tDate,tNow,sFormat,dSplitter,tSplitter,dtSeparator,Control)     
            Dim nS, strHNS, arHNS, iHNS, valHNS'Update 20090223 0135     
         
            If TypeName(tDate) = "Error" Then     
                tDate = Date()     
            End If     
            If TypeName(tNow) = "Error" Then     
                tNow = Now()     
            End If     
            If TypeName(dSplitter) = "Error" Then     
                dSplitter = "/"     
            End If     
            If TypeName(tSplitter) = "Error" Then     
                tSplitter = ":"     
            End If     
            If TypeName(Control) = "Error" Then     
                Control = 0     
            End If     
            If TypeName(dtSeparator) = "Error" Then     
                If Control = 1 Then     
                    dtSeparator = "*"     
                Else     
                    dtSeparator = " "     
                End If     
            End If     
         
            strS = Split(CStr(FormatDateTime(tNow,3)),":")(2)   'Update 20090223 0951     
            strHN = FormatDateTime(tNow,4)                      'Update 20090223 1428     
            strHNS = FormatDateTime(tNow,4) & tSplitter & strS  'Update 20090223 0951     
         
            If TypeName(sFormat) = "Error" Then     
                sFormat = "YMD" & dtSeparator & "HNS"     
            End If     
         
            If dSplitter = "/" Then     
            Else     
                tDate = Replace(tDate,"/",dSplitter)     
            End If     
            If tSplitter = ":" Then     
            Else     
                strHNS = Replace(strHNS,":",tSplitter)     
            End If     
         
            sFormat = Replace(sFormat,"YMD",tDate)     
            sFormat = Replace(sFormat,"HNS",strHNS)     
            sFormat = Replace(sFormat,"HN",strHN)     
            sFormat = Replace(sFormat,"S",strS)     
         
            If TypeName(sFormat) = "Error" Then     
            Else     
                wExist = Instr(1,sFormat,"W",1)     
            If wExist = 0 Then     
            Else     
                sFormat = Replace(sFormat,"W",strWeekday)     
            End If     
            End If     
            If Control = 0 Then     
                iDTw = sFormat     
            Else     
                iDTw = Split(sFormat,dtSeparator)     
            End If     
        End Function     
         
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'lArray - 文字列を１文字ずつバラし、配列として返す     
        '- Created by LazwardFox -     
         
            ' Release 20090228 1246     
         
            ' lArray(     
            '         strLetters  － 分解したい文字列     
            '        ,rArray  － 戻り値が代入されます。任意の変数名を指定      
            '        )     
         
        Function lArray(strLetters, rArray)     
            Dim Pc, rLetters()     
            Set objADO = CreateObject("ADODB.Stream")     
            With objADO     
                .Type = 2     
                .Open     
                .WriteText strLetters     
                Pc = 0     
                .Position = 0     
                Do Until .EOS     
                    ReDim Preserve rLetters(Pc)     
                    rLetters(Pc) = .ReadText(1)     
                    Pc = Pc + 1     
                Loop     
            End With     
            rArray = rLetters     
            objADO.Close     
            Set objADO = Nothing     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'inArrays - 多次元配列構築     
        '- Created by LazwardFox -     
             
            '配列 及び 文字列から、区切り文字を指定して多重配列を作成し返す。     
         
            ' inArrays(     
            '           tSources  － 区切り文字を含む文字列 ないし、それらで構成された配列     
            '          ,strLimitters  － 区切り文字を順番に並べた文字列を指定     
            '          ,arReturn  － 戻り値が代入されます。     
            '          )     
         
            ' Update 20090228 1248 strLimitters指定に、区切り文字 ~(チルダ)不要に。     
            ' Update 20090228 0833 配列のほか、文字列もソースに適用可能に。     
            ' Update 20090223 0917     
                 
        Function inArrays(tSources, strLimitters, arReturn)     
            Dim arSources, arLimitters, iLimitter, arInArrays, iSource, Pc     
            arSources = tSources     
            lArray strLimitters, arLimitters '＜ Update 20090228 1248     
            For Each iLimitter In arLimitters     
                If VarType(arSources) = 8 Then     
                    arInArrays = Split(arSources,iLimitter)     
                Else     
                    Pc = 0     
                    ReDim arInArrays(0)     
                    For Each iSource in arSources     
                        ReDim Preserve arInArrays(Pc)     
                        arInArrays(Pc) = Split(iSource,iLimitter)     
                        Pc = Pc + 1     
                    Next     
                End If     
                arSources = arInArrays     
                arInArrays = Null     
            Next     
            arReturn = arSources     
        End Function     


更に自由度の高い書式指定機能付スクリプトを作成するので、この分も要らなくなったりするww

似たようなものばかりでアレなんだケド、色んなデータへのアプローチの仕方があるというコトで、
なにかしら参考になっていればいいなぁ･･･(´ﾍ｀；)
＜そのまま使える スクリプト 年月日 曜日 時分秒 文字列 配列変数 取得 Format Text FormatDateTime＞