VBScriptでラクをする そにょ１･･･

ショートカット１クリックで複数フォルダを開けたら…
しかも、当日フォルダがあれば、そっちを見つけて開くとか勝手に出来ないものか･･･
ヒトの手を抜きたいという欲望には限りがないw

そう云う向きに使えるスクリプトなど･･･

   DateFolderOpener.zip    
▲ を、右クリックしてファイルとして保存してください。

ファイル名を任意に変えて、同名iniファイルを同じフォルダに配置して利用するのは、今まで紹介したモノと同様。
iniファイルも、単純に
   C:\WINDOWS
   C:\WINDOWS\system32\GroupPolicy    
と、云う具合に、フォルダを列挙するだけ。

但し、その配下が、
   [指定したフォルダ]
                └ yyyy
                    └ mm
                       └ dd    
と云うカタチの構成の場合で、当日を指すフォルダがあれば、ソチラを優先で開き、
それ以外の指定フォルダは、エクスプローラで ただ開くだけとなる。

下のソースを見てもらえば判ると思うが、コイツは今、うっかり間違って
自身へ フォルダ(複数可)をドロップしても動作するようになってる。
ただエクスプローラで開くだけなので、機能としては、ほぼ無意味。
なのでココは、ini自分で書くのも面倒になってきたってのもあるので、
ini他を自動作成するよう、処理差し替えようかとか考えている。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        'DateFolderOpener     
        '- Created by LazwardFox -     
              
         'パラメータ指定／iniファイル記述で、複数の同日日付フォルダを同時に開く。     
         '単独起動 － 処理なし     
              
         '注) 20090223 0300 タスクマネージャ動作時、直接指定の場合、パラメータ指定不可      
         
            ' Update 20090315 2240 lnkChk機能拡張     
            ' Update 20090315 1958 複数ドロップ、ショートカットドロップに対応。     
            ' Release 20090315 1431     
            ' DevStart 20090315 0812     
          
    '***** ↓↓↓ ObjectDecralations ↓↓↓ ************************************************     
        Dim Parameters, WSHShell, Fs     
             
        Set Parameters = WScript.Arguments 'パラメーター取得     
        Set WSHShell = WScript.CreateObject("WScript.Shell")     
        Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル制御     
         
    '***** ↓↓↓ Decralations ↓↓↓ ******************************************************     
        Const vbWq = """"     
        Dim win, Explorer, arTargets, iTargets, pTargets(), iRoot, nDT, tFolder, tExec     
        win = WSHShell.ExpandEnvironmentStrings("%systemroot%")     
        Explorer = Fs.BuildPath(win,"Explorer.exe") & " /e,"     
             
    '***** ↓↓↓MainRoutine↓↓↓ *********************************************************     
        'ParameterCheck BaseSet -----     
        If Parameters.Count = 0 Then     
            iTargets = arIni()     
        ElseIf Parameters.Count = 1 Then     
            iTargets = Split(Parameters(0),",")     
        ElseIf Parameters.Count >=2 Then     
            For Pc = 0 To Parameters.Count - 1     
                Redim Preserve pTargets(Pc)     
                pTargets(Pc) = Parameters(Pc)     
            Next     
            iTargets = pTargets     
        Else     
            Wscript.Quit     
        End IF     
        lnkChk iTargets, 1, arTargets '0 - .url無効化      
        '----------------------------     
        nDT = iDT("\"," ","",1)(0)     
        For Each iRoot In arTargets     
            If iRoot = "" Then     
            ElseIf Fs.FolderExists(iRoot) Then     
                tFolder = Fs.BuildPath(iRoot,nDT)     
                If Fs.FolderExists(tFolder) Then     
                Else     
                    tFolder = iRoot     
                End If     
                tExec = Explorer & tFolder     
                WSHShell.Run tExec, 1     
                Wscript.Sleep 500     
            End If     
        Next     
        Set Fs = Nothing     
        Set WSHShell = Nothing     
        Wscript.Quit     
             
    '***** ↓↓↓Functions↓↓↓ *********************************************************     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'lnkChk with scGet      
        '- Created by LazwardFox -     
             
        'パラメータがショートカットファイル(.lnk/.url)を指す場合、     
        'リンク先フルパスに差し替えて配列を返す。     
             
            ' Update 20090315 2240 Control処理拡張     
            ' Release 20090315 1958     
            ' DevStart 20090315 1634     
         
            'lnkChk(     
            '        SourceArray     配列での入力に限定されます。     
            '       ,Control         0 - .urlファイル(インターネットショートカット)は無効化     
            '                        1 - ショートカット内URL有効化 / 2 - 無条件     
            '       ,ResultArray     処理結果を配列で返します。無効な配列は削除されています。     
            '       )     
                     
        Function lnkChk(SourceArray,Control,ResultArray)     
            Dim Pc, iSA, eSA, cSA, lPass, ePass, rSAs()     
            Pc = 0     
            For Each iSA in SourceArray     
                eSA = Ucase(Fs.GetExtensionName(iSA))     
                cSA = (eSA = "LNK") or ((eSA = "URL") And Control > 0)     
                If cSA Then '-- lnk/url TargetGet     
                    scGet iSA, lPass     
                    ePass = Ucase(Fs.GetExtensionName(lPass))     
                     If ePass = "" Then '-- Folder True     
                    ElseIf Control >= 2 Then '-- All True - NoLimit     
                    ElseIf ePass = "HTML" And Control >= 1 Then '-- URL True     
                    Else '-- BadTarget     
                        lPass = ""     
                    End If      
                ElseIf eSA = "" Then '-- Folder     
                    lPass = iSA     
                Else '-- lnk/url Cancel     
                     lPass = ""     
                End If     
                If lPass = "" Then '-- NullSkip     
                Else '-- ArraySet     
                    Redim Preserve rSAs(Pc)     
                    rSAs(Pc) = lPass     
                    Pc = Pc + 1     
                End If      
            Next     
            ResultArray = rSAs     
        End Function     
             
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'scGet - ショートカットファイル(.lnk/.url)のリンク先フルパスを返す。     
        '- Created by LazwardFox -     
             
            'Update      
            'Release 20090315 1958     
            ' DevStart 20090315 1634     
                     
            '    scGet(     
            '          scSource      ショートカットファイルのフルパスを指定     
            '         ,scResult      ショートカット内のリンク先を返します。     
            '                        任意の変数を割り当ててください。     
            '         )     
                 
        Function scGet(scSource, scResult)     
            Dim tSc     
            If Fs.FileExists(scSource) Then     
                Set tSc = WSHShell.CreateShortcut(scSource)     
                scResult = tSc.TargetPath     
                Set tSc = Nothing     
            Else     
                scResult = ""     
            End If     
        End Function     
                     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iDT - 日時文字列 ないし 日/時配列取得 for VBScript     
        '- Created by LazwardFox -     
             
            ' Update 20090228 0458 変数宣言変更     
            ' Update 20090223 0959 時刻桁処理変更     
            ' Update 20090223 0253 Len記述忘れ修正     
            ' Update 20090223 0135 変数宣言忘れ修正     
            ' Update 20090210 0218     
            ' Update 20090210 0115     
            ' Release 20090209 2035     
         
            '    iDT (     
            '     dSplitter - DateSplitString             (Normal - "/")     
            '    ,dtSeparater - Date/Time SepaleteString (Normal - " ")     
            '    ,tSplitter - TimeSplitString             (Normal - ":")     
            '    ,Control - 配列化 0 or 1                (Default - 1)     
            '    )     
         
        Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)     
            Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458     
            nX = Now()     
            nD = FormatDateTime(Date(),0)     
            nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2) 'Update 20090223 0951     
            strHMS = FormatDateTime(nX,4) & nS                  'Update 20090223 0951     
            If tSplitter = ":" Then     
            Else     
                strHMS = Replace(strHMS,":",tSplitter)     
            End If     
            sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS     
            If Control = 1 Then     
                iDT = Split(sResult,"*")     
            Else     
                iDT = Replace(sResult,"*",dtSeparater)                 
            End If     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'arIni with iniLoader     
        '- Created by LazwardFox -     
         
            'スクリプトと同名のiniファイルがあれば、内容を配列で取得     
            '対象フォルダを取得、iniファイルがあれば優先する。戻り値は配列     
         
            ' Update 20090223 0550 変則的フォルダ名回避のため修正     
            ' Release 20090223 0509     
         
        Public Function arIni()     
            Dim sNFull, rFolder, sN, iniFile      
            sNFull = Wscript.ScriptFullName     
            rFolder = Fs.GetParentFolderName(sNFull)     
            sN = Fs.GetBaseName(sNFull)     
            iniFile = Fs.BuildPath(rFolder,sN & ".ini")     
            If Fs.FileExists(iniFile) Then     
                arIni = iniLoader(iniFile,0)     
            Else     
                arIni = Array(rFolder)     
            End If     
        End Function     
                         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iniLoarder - 対象をiniファイルより取得。     
        '- Created by LazwardFox -     
         
            ' Update 20090223 0550 戻り値可変 [ 0 - 配列 ] [ 1 - カンマ区切り文字列 ]     
            ' Release 20090223 0509     
         
        Public Function iniLoader(iniFile, Control)     
            Dim nS     
            nS = Fs.GetFile(iniFile).size     
            If nS = 0 Then     
                iniLoader = Array(Fs.GetParentFolderName(iniFile))     
            Else     
                Dim  iFile, lResult, strResults     
                Set iFile = Fs.OpenTextFile(iniFile,1) 'iniファイルを読み取りモードで開く     
                WScript.Sleep 150     
                Do Until iFile.AtEndOfStream '読み込み     
                    lResult = lResult & ";" & iFile.ReadLine & ";"     
                Loop     
                WScript.Sleep 150     
                iFile.Close 'Iniファイルを閉じる     
                strResults = Replace(Replace(lResult,";;",","),";","")     
                If Control = 0 Then     
                    iniLoader = Split(strResults, ",")     
                Else     
                    iniLoader = strResults     
                End If     
            End If             
        End Function     


関数毎にバラバラに管理してたファイルから寄せ集めたので、
クレジットまでダブってしまっているのは御愛嬌ってコトで･･･^_^;
＜そのまま使えるVBScript 日付 フォルダ 作成 自動化 複数 ルートフォルダ 指定可能＞