- VBScriptについて必死に話し合うスレ [転載禁止]©2ch.net
472 ：デフォルトの名無しさん[]：2015/07/13(月) 22:30:46.86 ID:T1+CoqDj - ごめんなさい。
一応動く物を…
Option Explicit
'移動先フォルダ
Const cMoveTo = "d:\backup"
Dim objShell
Dim objFileSys
Dim strMoveFrom
Dim strMoveTo
Dim strMsg
Set objShell = CreateObject("WScript.Shell")
Set objFileSys = CreateObject("Scripting.FileSystemObject")
'引数が指定されていない場合は終了
If WScript.Arguments.Count = 0 Then WScript.Quit
| - VBScriptについて必死に話し合うスレ [転載禁止]©2ch.net
473 ：デフォルトの名無しさん[]：2015/07/13(月) 22:31:18.36 ID:T1+CoqDj - '引数から移動元フォルダを取得
For Each strMoveFrom In WScript.Arguments
'移動元フォルダの存在チェック
If Not objFileSys.FolderExists(strMoveFrom) Then
WScript.echo "移動元フォルダが存在しません。[" & strMoveFrom & "]"
WScript.Quit
End If
'移動先フォルダの作成
If Not MakePath(cMoveTo) Then
WScript.Echo "移動先フォルダが作成出来ませんでした。[" & cMoveTo & "]"
WScript.Quit
End If
'移動先フォルダ名の生成
strMoveTo = objFileSys.BuildPath(cMoveTo, Split(strMoveFrom,"\")(UBound(Split(strMoveFrom,"\"))))
strMsg = "[" & objFileSys.GetFolder(strMoveFrom).Name & "] を [" & cMoveTo & "] に"
On Error Resume Next
'フォルダが存在する場合はコピー後に削除
objFileSys.CopyFolder strMoveFrom, strMoveTo, True
If Err.Number = 0 Then
objFileSys.DeleteFolder strMoveFrom, True
WScript.echo strMsg & "移動しました。"
Else
WScript.echo strMsg & "移動出来ませんでした。[" & Err.Description & "]"
End If
Next
| - VBScriptについて必死に話し合うスレ [転載禁止]©2ch.net
474 ：デフォルトの名無しさん[]：2015/07/13(月) 22:31:41.65 ID:T1+CoqDj - Set objShell = Nothing
Set objFileSys = Nothing
Function MakePath(Path)
Dim objFileSys,LPath,MPath,Start
Set objFileSys = CreateObject("Scripting.FilesystemObject")
LPath = Path
If Right(LPath,1) <> "\" Then LPath = LPath & "\"
Start = 1
MakePath = False
Do
MPath = Left(LPath,InStr(Start,LPath,"\"))
If Not objFileSys.FolderExists(MPath) Then
On Error Resume Next
objFileSys.CreateFolder MPath
If Err.Number <> 0 Then
WScript.Echo Err.Description
Exit Function
End If
On Error Goto 0
End If
Start = InStr(Start,LPath,"\") + 1
If InStr(Start,LPath,"\") = 0 Then Exit Do
Loop
MakePath = objFileSys.FolderExists(Path)
Set objFileSys = Nothing
End Function
|
|