ドラッグドロップ全ファイルループモジュールその３ 進捗表示機能搭載
2023年12月26日
前々回、Bing AIを使ってVBScriptのソースコードを生成して、
そのまま実行したら良好な結果を得られた。
「ドラッグドロップ標準モジュール」
この内容に対して、過去に作った進捗状況をファイル名で表示するモジュールを組み合わせるべく
またしてもBing AIを使って改良を試みた。
そのまま実行したら良好な結果を得られた。
「ドラッグドロップ標準モジュール」
この内容に対して、過去に作った進捗状況をファイル名で表示するモジュールを組み合わせるべく
またしてもBing AIを使って改良を試みた。
プロンプトは以下の通り。
以下の２つのプログラムを組み合わせて、ドラッグドロップによる処理の進捗を表示するVBScriptのソースコードを生成して。
'ドラッグドロップ
Dim objFSO, objArgs, strFolder, strFile, strPath, strExtension
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then
strFolder = objFSO.GetParentFolderName(WScript.ScriptFullName)
Else
For Each strPath In objArgs
If objFSO.FolderExists(strPath) Then
ProcessFolder strPath
ElseIf objFSO.FileExists(strPath) Then
ProcessFile strPath
End If
Next
End If
Sub ProcessFolder(strFolderPath)
Dim objFolder, objFile, colFiles
Set objFolder = objFSO.GetFolder(strFolderPath)
Set colFiles = objFolder.Files
For Each objFile In colFiles
ProcessFile objFile.Path
Next
Set colFiles = Nothing
Set objFolder = Nothing
End Sub
Sub ProcessFile(strFilePath)
strExtension = objFSO.GetExtensionName(strFilePath)
If LCase(strExtension) = "csv" Then
' Do something with the file
End If
End Sub
'プログレスバー
dim text:text ="400件／750件"
call outputprogress(text)
sub outputProgress(text)
call deletePrgrsFile
call makePrgrsFile(text)
end sub
'------------------------------
' メイン処理
'------------------------------
Sub makePrgrsFile(text)
dim myPath : myPath = Wscript.scriptFullname
dim yPos : yPos = instrrev(myPath , "\")
dim strFile: strFile = left(myPath,yPos) & "VBS進行率：" & text & ".prgrs"
dim objFS: Set objFS = CreateObject("Scripting.FileSystemObject")
dim obfFile : Set obfFile = objFS.CreateTextFile(strFile) ' ファイル作成
set objFS = nothing
set obfFile = nothing
end sub
sub deletePrgrsFile()
on error resume next
dim myPath : myPath = Wscript.scriptFullname
dim yPos : yPos = instrrev(myPath , "\")
dim tarFile:tarFile = left(myPath,yPos) & "*.prgrs"
with CreateObject("Scripting.FileSystemObject")
.DeleteFile tarFile
end with
end sub
得られた結果はこちら。
'-----------------------------------------------------------結果
'ドラッグドロップ
Dim objFSO, objArgs, strFolder, strFile, strPath, strExtension
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then
strFolder = objFSO.GetParentFolderName(WScript.ScriptFullName)
Else
For Each strPath In objArgs
If objFSO.FolderExists(strPath) Then
ProcessFolder strPath
ElseIf objFSO.FileExists(strPath) Then
ProcessFile strPath
End If
Next
End If
Sub ProcessFolder(strFolderPath)
Dim objFolder, objFile, colFiles
Set objFolder = objFSO.GetFolder(strFolderPath)
Set colFiles = objFolder.Files
For Each objFile In colFiles
ProcessFile objFile.Path
Next
Set colFiles = Nothing
Set objFolder = Nothing
End Sub
Sub ProcessFile(strFilePath)
strExtension = objFSO.GetExtensionName(strFilePath)
If LCase(strExtension) = "csv" Then
' Do something with the file
End If
End Sub
'プログレスバー
dim text:text ="400件／750件"
call outputprogress(text)
sub outputProgress(text)
call deletePrgrsFile
call makePrgrsFile(text)
end sub
'------------------------------
' メイン処理
'------------------------------
Sub makePrgrsFile(text)
dim myPath : myPath = Wscript.scriptFullname
dim yPos : yPos = instrrev(myPath , "\")
dim strFile: strFile = left(myPath,yPos) & "VBS進行率：" & text & ".prgrs"
dim objFS: Set objFS = CreateObject("Scripting.FileSystemObject")
dim obfFile : Set obfFile = objFS.CreateTextFile(strFile) ' ファイル作成
set objFS = nothing
set obfFile = nothing
end sub
sub deletePrgrsFile()
on error resume next
dim myPath : myPath = Wscript.scriptFullname
dim yPos : yPos = instrrev(myPath , "\")
dim tarFile:tarFile = left(myPath,yPos) & "*.prgrs"
with CreateObject("Scripting.FileSystemObject")
.DeleteFile tarFile
end with
end sub
自分の好みに文字を変えたり、表示を変更したり。正しく動いているかどうかすぐ確認できなかったので、
各ポイントでメッセージを表示して動作を確認。
特に修正する点はなかった。
改良したソースがこちら。
フォルダ内にファイルがたくさんある場合を想定して、
フォルダを処理したときの進捗を別途表示するようにした。
表示する文字列をグローバルの位置で宣言しておくと
各モジュール間で受け渡さなくて良いので楽ちんだった。
Option Explicit
'ドラッグドロップ
Dim objArgs : Set objArgs = WScript.Arguments '入力
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFolder, strFile, strPath, strExt
Dim cnt, stText
If objArgs.Count = 0 Then
strFolder = objFSO.GetParentFolderName(WScript.ScriptFullName)
call ProcessFolder(strFolder)
Else
For Each strPath In objArgs
cnt = cnt + 1
stText = cnt & "／" & objArgs.count & "件目"
call outputprogress(stText) 'プログレスバー
If objFSO.FolderExists(strPath) Then
call ProcessFolder(strPath)
ElseIf objFSO.FileExists(strPath) Then
call ProcessFile(strPath)
End If
Next
End If
Sub ProcessFolder(strFolderPath)
Dim objFolder, objFile, colFiles,fcnt
Set objFolder = objFSO.GetFolder(strFolderPath)
Set colFiles = objFolder.Files
For Each objFile In colFiles
fcnt = fcnt + 1
stText = cnt & "／" & objArgs.count & "件目（Dir内 " & fcnt & "／" & colFiles.count & "）"
call outputprogress(stText) 'プログレスバー
call ProcessFile(objFile.Path)
Next
Set colFiles = Nothing
Set objFolder = Nothing
End Sub
'ファイルに対するメイン処理
Sub ProcessFile(strFilePath)
strExt = objFSO.GetExtensionName(strFilePath)
msgbox strFilePath
If LCase(strExt) = "csv" Then
' Do something with the file
End If
End Sub
'-----------------------------------------------------------'プログレスバー
sub outputProgress(text)
call deletePrgrsFile
if text <> "" then call makePrgrsFile(text)
end sub
Sub makePrgrsFile(text)
dim myPath : myPath = Wscript.scriptFullname
dim yPos : yPos = instrrev(myPath , "\")
dim strFile: strFile = left(myPath,yPos) & "Args：" & text & ".prgrs"
dim objFS: Set objFS = CreateObject("Scripting.FileSystemObject")
dim obfFile : Set obfFile = objFS.CreateTextFile(strFile) ' ファイル作成
set objFS = nothing
set obfFile = nothing
end sub
sub deletePrgrsFile()
on error resume next
dim myPath : myPath = Wscript.scriptFullname
dim yPos : yPos = instrrev(myPath , "\")
dim tarFile:tarFile = left(myPath,yPos) & "*.prgrs"
with CreateObject("Scripting.FileSystemObject")
.DeleteFile tarFile
end with
end sub
PR
Comment