|
こんにちは。
うまくいったようでよかったです。
それで、昨日メールを送信してから気づいたんですが、1か所エラー処理が抜けて
いました。
例えば、コンピュータ(Windows10だとPC)のような現在のディレクトリが取得で
きない状態でこのスクリプトを実行すると、エラーも何も出ずに終了してしまうので、
その対策をしました。
まあ、そんなことはめったにしないと思いますが。
あと、一応フォルダがちゃんと作成されたかどうかチェックするようにして、作成
されていないようであれば、エラーを出すようにしました。
ということで、よろしければ柿スクリプトに差し替えていただければと思います。
--------------------
'宣言部
Dim strNowYear
Dim strNowMonth
Dim strNowDay
Dim strFormattedDate
Dim strCurrentDir
Dim strDestDir
Dim ObjFso
Dim MB_ICONEXCLAMATION
MB_ICONEXCLAMATION = 48
'秀丸ファイラーClassicから実行されたとき以外のためのエラー処理
strWScriptType = TypeName(WScript)
If LCase(strWScriptType) = "object" Then
strMsg = _
"このスクリプトは秀丸ファイラーClassic専用です。" & vbCr & _
vbCr & _
"「ブックマークの整理」または「ツールの整理」で「追加」して、" & _
"パスの右側の「>>」ボタンの「スクリプトの参照」より、このファ" & _
"イルを指定して登録してください。" & vbCr & _
"(パスの先頭に「script:」と書かれたパスとして登録)"
WScript.Echo strMsg
WScript.Quit
End If
'現在の日付を取得
strNowYear = PadLeft(Year(Now), 4, 0)
strNowMonth = PadLeft(Month(Now), 2, 0)
strNowDay = PadLeft(Day(Now), 2, 0)
'yyyy/mm/dd 形式に成形
strFormattedDate = strNowYear+"-"+strNowMonth+"-"+strNowDay
'現在のディレクトリを取得
strCurrentDir = getDirectory()
'コンピュータ等、現在のディレクトリを取得できなかったときにメッセージを表示
して、スクリプトを中断
If strCurrentDir = "" Then
message "現在のディレクトリを取得できませんでした。", MB_ICONEXCLAMATION
EndMacro
End If
'あとあと楽なように作成先のフォルダを変数に入れておく
strDestDir = strCurrentDir+"\"+strFormattedDate
'ディレクトリを作成
Set ObjFso=CreateObject("Scripting.FileSystemObject")
ObjFso.CreateFolder(strDestDir)
'フォルダがちゃんと作成されているか調べて、作成されていなければエラーメッ
セージを表示
If ObjFso.FolderExists(strDestDir) = 0 Then
message "フォルダの作成に失敗しました。", MB_ICONEXCLAMATION
EndMacro
End If
Set ObjFso = Nothing
Set strFormattedDate = Nothing
'桁数をそろえるための関数
Function PadLeft(stTarget, iLength, chOne)
Do While (Len(stTarget) < iLength)
stTarget = chOne & stTarget
Loop
PadLeft = Right(stTarget, iLength)
End Function
--------------------
それでは。
|
|