2009/03/17

VBScriptでラクをする そにょ1・・・


ショートカット1クリックで複数フォルダを開けたら…
しかも、当日フォルダがあれば、そっちを見つけて開くとか勝手に出来ないものか・・・
ヒトの手を抜きたいという欲望には限りがない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 日付 フォルダ 作成 自動化 複数 ルートフォルダ 指定可能>

0 件のコメント:

コメントを投稿