【VBA】FSOを使用してファイルの読み・書き・追記を行う
<機能>
FSO(FileSystemObject)を使ってファイルの読み・書き・追記を行うサンプルです
(1)ファイルにテキストを書き込む
(2)ファイルにテキストを追記する
(3)ファイルからテキストを読み込む
(4)フォルダを作成する
(5)ファイルを別フォルダにリネームしてコピーする
(6)ファイルをワイルドカードを使用して別フォルダにコピーする
(7)ファイルを削除する
<実行イメージ>
上記(1)〜(7)実行後のイメージです
(1)(2) ファイル書き込み・追記を行います
(3) 追記を行ったファイルを読み込み結果をシートに出力します
(4)(5) フォルダを作成し作成したファイルを100回コピーします
(6) 100回コピーされたファイルを別フォルダにワイルドカードを使用してコピーします
(7) コピーしたファイルからファイル末尾に不可した数値が10の倍数のファイルを削除します
<動作検証&開発環境>
Microsoft Office 2016
<使い方>
(1)参照設定を行います
[Alt]+[F11]でVBE(VBAエディター)を表示します
メニューの[ツール(T)]から[参照設定(R)]を選択します
Microsoft Scripting Runtimeをチェックして[OK]を押下してください
これによりForReading / TristateFalseなどの定数が使用できるようになります
(2)標準モジュールを追加してソースを貼り付けます
(3)「FSOでファイルを操作する」 プロシージャを実行します
Option Explicit
'/*********************************************
'/ ファイル操作メイン処理
'/ このプロシージャをコールする
'/*********************************************
Public Sub FSOでファイルを操作する()
Dim strfile As String
Dim strfolder As String, strfolder2 As String
Dim strtxt As String, strbuf() As String
Dim i As Integer
'//データは横浜市の区ごとの総人口と男女別人口
strtxt = "横浜市全体,3724844,1855985,1868859" & vbCrLf & _
"鶴見区,285356,147650,137706" & vbCrLf & _
"神奈川区,238966,121769,117197" & vbCrLf & _
"西区,98532,49850,48682" & vbCrLf & _
"中区,148312,78087,70225" & vbCrLf & _
"南区,194827,97006,97821" & vbCrLf & _
"保土ヶ谷区,205493,102381,103112" & vbCrLf & _
"磯子区,166229,81827,84402" & vbCrLf & _
"金沢区,202229,99167,103062" & vbCrLf & _
"港北区,344172,174460,169712" & vbCrLf & _
"戸塚区,275283,135271,140012" & vbCrLf & _
"港南区,215736,106126,109610" & vbCrLf & _
"旭区,247144,120168,126976" & vbCrLf & _
"緑区,180366,89002,91364" & vbCrLf & _
"瀬谷区,124560,60889,63671" & vbCrLf & _
"栄区,122171,59729,62442" & vbCrLf & _
"泉区,154025,75460,78565" & vbCrLf & _
"青葉区,309692,151182,158510" & vbCrLf & _
"都筑区,211751,105961,105790" & vbCrLf
'//ファイルパス
strfile = ThisWorkbook.Path & "¥fsotest.txt"
'//――――――――――――――――――――――
'//(1)ファイルにテキストを書き込む
If Not WriteUsingFSO(strtxt, strfile) Then
MsgBox "ファイル書き込み(WriteUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(2)ファイルにテキストを追記する
If Not AppendUsingFSO(strtxt, strfile) Then
MsgBox "ファイルへの追記(AppendUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(3)ファイルからテキストを読み込む
If Not ReadUsingFSO(strbuf, strfile) Then
MsgBox "ファイル読み込み(ReadUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//結果表示
For i = 0 To UBound(strbuf)
'セル内折り返しを解除
Range("A" & CStr(i + 1)).WrapText = False
'読み込みデータを出力
Range("A" & CStr(i + 1)).Value = strbuf(i)
Next
'//――――――――――――――――――――――
'//(4)フォルダを作成する
strfolder = ThisWorkbook.Path & "¥" & Format(Now, "yyyymmddhhmmss")
If Not CreateDirUsingFSO(strfolder) Then
MsgBox "フォルダ作成(CreateDirUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'/ ファイル操作メイン処理
'/ このプロシージャをコールする
'/*********************************************
Public Sub FSOでファイルを操作する()
Dim strfile As String
Dim strfolder As String, strfolder2 As String
Dim strtxt As String, strbuf() As String
Dim i As Integer
'//データは横浜市の区ごとの総人口と男女別人口
strtxt = "横浜市全体,3724844,1855985,1868859" & vbCrLf & _
"鶴見区,285356,147650,137706" & vbCrLf & _
"神奈川区,238966,121769,117197" & vbCrLf & _
"西区,98532,49850,48682" & vbCrLf & _
"中区,148312,78087,70225" & vbCrLf & _
"南区,194827,97006,97821" & vbCrLf & _
"保土ヶ谷区,205493,102381,103112" & vbCrLf & _
"磯子区,166229,81827,84402" & vbCrLf & _
"金沢区,202229,99167,103062" & vbCrLf & _
"港北区,344172,174460,169712" & vbCrLf & _
"戸塚区,275283,135271,140012" & vbCrLf & _
"港南区,215736,106126,109610" & vbCrLf & _
"旭区,247144,120168,126976" & vbCrLf & _
"緑区,180366,89002,91364" & vbCrLf & _
"瀬谷区,124560,60889,63671" & vbCrLf & _
"栄区,122171,59729,62442" & vbCrLf & _
"泉区,154025,75460,78565" & vbCrLf & _
"青葉区,309692,151182,158510" & vbCrLf & _
"都筑区,211751,105961,105790" & vbCrLf
'//ファイルパス
strfile = ThisWorkbook.Path & "¥fsotest.txt"
'//――――――――――――――――――――――
'//(1)ファイルにテキストを書き込む
If Not WriteUsingFSO(strtxt, strfile) Then
MsgBox "ファイル書き込み(WriteUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(2)ファイルにテキストを追記する
If Not AppendUsingFSO(strtxt, strfile) Then
MsgBox "ファイルへの追記(AppendUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(3)ファイルからテキストを読み込む
If Not ReadUsingFSO(strbuf, strfile) Then
MsgBox "ファイル読み込み(ReadUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//結果表示
For i = 0 To UBound(strbuf)
'セル内折り返しを解除
Range("A" & CStr(i + 1)).WrapText = False
'読み込みデータを出力
Range("A" & CStr(i + 1)).Value = strbuf(i)
Next
'//――――――――――――――――――――――
'//(4)フォルダを作成する
strfolder = ThisWorkbook.Path & "¥" & Format(Now, "yyyymmddhhmmss")
If Not CreateDirUsingFSO(strfolder) Then
MsgBox "フォルダ作成(CreateDirUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(5)ファイルを別フォルダにリネームしてコピー
If Not CopyFileUsingFSO(strfile, strfolder) Then
MsgBox "ファイルコピー(CopyFileUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(6)ファイルをワイルドカードを使用して別フォルダにコピー
'//先に移動先フォルダを作成する(フォルダ名が重複しないように1秒Wait)
Application.Wait Now + TimeValue("0:00:01")
strfolder2 = ThisWorkbook.Path & "¥" & Format(Now, "yyyymmddhhmmss")
If Not CreateDirUsingFSO(strfolder2) Then
MsgBox "フォルダ作成(CreateDirUsingFSO2)に失敗しました", vbCritical
Exit Sub
End If
'//strfolderに含まれるすべての".txt"ファイルをstrfolder2にコピーする
If Not CopyFileUsingFSO2(strfolder, strfolder2) Then
MsgBox "ファイルコピー(CopyFileUsingFSO2)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(7)ファイルを削除する
'//strfolder2から指定ファイルを削除する
If Not DeleteFileUsingFSO(strfolder2) Then
MsgBox "ファイル削除(DeleteFileUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
End Sub
'//(5)ファイルを別フォルダにリネームしてコピー
If Not CopyFileUsingFSO(strfile, strfolder) Then
MsgBox "ファイルコピー(CopyFileUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(6)ファイルをワイルドカードを使用して別フォルダにコピー
'//先に移動先フォルダを作成する(フォルダ名が重複しないように1秒Wait)
Application.Wait Now + TimeValue("0:00:01")
strfolder2 = ThisWorkbook.Path & "¥" & Format(Now, "yyyymmddhhmmss")
If Not CreateDirUsingFSO(strfolder2) Then
MsgBox "フォルダ作成(CreateDirUsingFSO2)に失敗しました", vbCritical
Exit Sub
End If
'//strfolderに含まれるすべての".txt"ファイルをstrfolder2にコピーする
If Not CopyFileUsingFSO2(strfolder, strfolder2) Then
MsgBox "ファイルコピー(CopyFileUsingFSO2)に失敗しました", vbCritical
Exit Sub
End If
'//――――――――――――――――――――――
'//(7)ファイルを削除する
'//strfolder2から指定ファイルを削除する
If Not DeleteFileUsingFSO(strfolder2) Then
MsgBox "ファイル削除(DeleteFileUsingFSO)に失敗しました", vbCritical
Exit Sub
End If
End Sub
'/*********************************************
'/ ファイル書き込み(FSOでテキストファイルに書き込み)
'/ stxt : 書き込みテキスト
'/ sfil : 書き込みファイル
'/*********************************************
Private Function WriteUsingFSO(ByVal stxt As String, ByVal sfil As String) As Boolean
On Error GoTo LblError
Dim myfso As Object, writefso As Object
'//初期値Falseを設定
WriteUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//TextStreamオブジェクトを[上書き]・[ASCIIファイル]で作成(詳細はDeveloperNetwork参照)
Set writefso = myfso.CreateTextFile(sfil, True, False)
'//引数は省略可能なので以下でもよい
'//Set writefso = myfso.CreateTextFile(sfil)
'//ファイルがなければ作成、あれば上書きとなる
writefso.Write stxt
'//TextStreamオブジェクトを閉じる
writefso.Close
WriteUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/ ファイル書き込み(FSOでテキストファイルに書き込み)
'/ stxt : 書き込みテキスト
'/ sfil : 書き込みファイル
'/*********************************************
Private Function WriteUsingFSO(ByVal stxt As String, ByVal sfil As String) As Boolean
On Error GoTo LblError
Dim myfso As Object, writefso As Object
'//初期値Falseを設定
WriteUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//TextStreamオブジェクトを[上書き]・[ASCIIファイル]で作成(詳細はDeveloperNetwork参照)
Set writefso = myfso.CreateTextFile(sfil, True, False)
'//引数は省略可能なので以下でもよい
'//Set writefso = myfso.CreateTextFile(sfil)
'//ファイルがなければ作成、あれば上書きとなる
writefso.Write stxt
'//TextStreamオブジェクトを閉じる
writefso.Close
WriteUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/*********************************************
'/ ファイルへ追記(FSOでテキストファイルに追記する)
'/ stxt : 追記するテキスト
'/ sfil : 追記ファイル
'/*********************************************
Private Function AppendUsingFSO(ByVal stxt As String, ByVal sfil As String) As Boolean
On Error GoTo LblError
Dim myfso As Object, appendfso As Object
'//初期値Falseを設定
AppendUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//TextStreamオブジェクトを[ファイルの最後に追記]・[ファイルを作成しない]・[ASCIIファイル]で作成(詳細はDeveloperNetwork参照)
Set appendfso = myfso.OpenTextFile(sfil, ForAppending, False, TristateFalse)
'//ファイルの最後に追記する
appendfso.Write stxt
'//TextStreamオブジェクトを閉じる
appendfso.Close
AppendUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/ ファイルへ追記(FSOでテキストファイルに追記する)
'/ stxt : 追記するテキスト
'/ sfil : 追記ファイル
'/*********************************************
Private Function AppendUsingFSO(ByVal stxt As String, ByVal sfil As String) As Boolean
On Error GoTo LblError
Dim myfso As Object, appendfso As Object
'//初期値Falseを設定
AppendUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//TextStreamオブジェクトを[ファイルの最後に追記]・[ファイルを作成しない]・[ASCIIファイル]で作成(詳細はDeveloperNetwork参照)
Set appendfso = myfso.OpenTextFile(sfil, ForAppending, False, TristateFalse)
'//ファイルの最後に追記する
appendfso.Write stxt
'//TextStreamオブジェクトを閉じる
appendfso.Close
AppendUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/*********************************************
'/ ファイル読み込み(FSOでテキストファイルから読み込み)
'/ sbuf : 読み込みテキスト(参照渡し)
'/ sfil : 読み込みファイル
'/*********************************************
Private Function ReadUsingFSO(ByRef sbuf() As String, ByVal sfil As String) As Boolean
On Error GoTo LblError
Dim myfso As Object, readfso As Object
Dim strwk As String
'//初期値Falseを設定
ReadUsingFSO = False
ReDim sbuf(0)
sbuf(0) = ""
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//TextStreamオブジェクトを[読み取り専用]・[ファイルを作成しない]・[ASCIIファイルとして開く]で作成(詳細はDeveloperNetwork参照)
Set readfso = myfso.OpenTextFile(sfil, ForReading, False, TristateFalse)
'//引数は省略可能なので以下でもよい
'//Set readfso = myfso.OpenTextFile(sfil,ForReading)
'//TextStreamファイル全体を読み込む(改行コードが読み込めない)
'//sbuf = readfso.ReadAll
'//TextStreamファイルを1行ずつ読み込む
Do While readfso.AtEndOfStream <> True
strwk = readfso.ReadLine
If sbuf(UBound(sbuf)) <> "" Then
ReDim Preserve sbuf(UBound(sbuf) + 1)
sbuf(UBound(sbuf)) = ""
End If
sbuf(UBound(sbuf)) = strwk
Loop
'//TextStreamオブジェクトを閉じる
readfso.Close
ReadUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/*********************************************
'/ フォルダ作成(FSOでフォルダを作成)
'/ sfol : 作成フォルダパス
'/*********************************************
Private Function CreateDirUsingFSO(ByVal sfol As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
'//初期値Falseを設定
CreateDirUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//フォルダの存在チェック
If myfso.FolderExists(sfol) Then GoTo LblError
'//フォルダを作成する
myfso.CreateFolder sfol
CreateDirUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/ ファイル読み込み(FSOでテキストファイルから読み込み)
'/ sbuf : 読み込みテキスト(参照渡し)
'/ sfil : 読み込みファイル
'/*********************************************
Private Function ReadUsingFSO(ByRef sbuf() As String, ByVal sfil As String) As Boolean
On Error GoTo LblError
Dim myfso As Object, readfso As Object
Dim strwk As String
'//初期値Falseを設定
ReadUsingFSO = False
ReDim sbuf(0)
sbuf(0) = ""
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//TextStreamオブジェクトを[読み取り専用]・[ファイルを作成しない]・[ASCIIファイルとして開く]で作成(詳細はDeveloperNetwork参照)
Set readfso = myfso.OpenTextFile(sfil, ForReading, False, TristateFalse)
'//引数は省略可能なので以下でもよい
'//Set readfso = myfso.OpenTextFile(sfil,ForReading)
'//TextStreamファイル全体を読み込む(改行コードが読み込めない)
'//sbuf = readfso.ReadAll
'//TextStreamファイルを1行ずつ読み込む
Do While readfso.AtEndOfStream <> True
strwk = readfso.ReadLine
If sbuf(UBound(sbuf)) <> "" Then
ReDim Preserve sbuf(UBound(sbuf) + 1)
sbuf(UBound(sbuf)) = ""
End If
sbuf(UBound(sbuf)) = strwk
Loop
'//TextStreamオブジェクトを閉じる
readfso.Close
ReadUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/*********************************************
'/ フォルダ作成(FSOでフォルダを作成)
'/ sfol : 作成フォルダパス
'/*********************************************
Private Function CreateDirUsingFSO(ByVal sfol As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
'//初期値Falseを設定
CreateDirUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//フォルダの存在チェック
If myfso.FolderExists(sfol) Then GoTo LblError
'//フォルダを作成する
myfso.CreateFolder sfol
CreateDirUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/*********************************************
'/ ファイルコピー(FSOでファイルをリネームしてコピー)
'/ sfil : コピー元ファイル
'/ sfol : コピー先フォルダ
'/*********************************************
Private Function CopyFileUsingFSO(ByVal sfil As String, ByVal sfol As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
Dim newfil As String, i As Integer
Dim strtmp As String
'//初期値Falseを設定
CopyFileUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//サンプルとして100回コピーする
strtmp = Right(sfil, Len(sfil) - InStrRev(sfil, "¥"))
For i = 1 To 100
newfil = sfol & "¥" & Left(strtmp, InStrRev(strtmp, ".") - 1) & "_" & Format(CStr(i), "000") & ".txt"
'ファイルを指定フォルダにリネームしてコピー
'[コピー元]・[コピー先]・[ファイルが存在する場合は上書き]でコピー(詳細はDeveloperNetwork参照)
myfso.CopyFile sfil, newfil, True
Next
CopyFileUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/ ファイルコピー(FSOでファイルをリネームしてコピー)
'/ sfil : コピー元ファイル
'/ sfol : コピー先フォルダ
'/*********************************************
Private Function CopyFileUsingFSO(ByVal sfil As String, ByVal sfol As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
Dim newfil As String, i As Integer
Dim strtmp As String
'//初期値Falseを設定
CopyFileUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//サンプルとして100回コピーする
strtmp = Right(sfil, Len(sfil) - InStrRev(sfil, "¥"))
For i = 1 To 100
newfil = sfol & "¥" & Left(strtmp, InStrRev(strtmp, ".") - 1) & "_" & Format(CStr(i), "000") & ".txt"
'ファイルを指定フォルダにリネームしてコピー
'[コピー元]・[コピー先]・[ファイルが存在する場合は上書き]でコピー(詳細はDeveloperNetwork参照)
myfso.CopyFile sfil, newfil, True
Next
CopyFileUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/*********************************************
'/ ファイルコピー(FSOでワイルドカードを使用してファイルを一括コピー)
'/ ワイルドカードが使用できるのはファイル名のみです
'/ sfol1 : コピー元ファイル
'/ sfol2 : コピー先フォルダ
'/*********************************************
Private Function CopyFileUsingFSO2(ByVal sfol1 As String, ByVal sfol2 As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
'//初期値Falseを設定
CopyFileUsingFSO2 = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//[コピー元]・[コピー先]・[ファイルが存在する場合は上書き]でコピー
'//対象は拡張子が".txt"のファイル
myfso.CopyFile sfol1 & "¥*.txt", sfol2 & "¥", True
'//ファイルを移動する場合はMoveFileを使用する
'//myfso.MoveFile sfol1 & "¥*.txt", sfol2 & "¥"
CopyFileUsingFSO2 = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/ ファイルコピー(FSOでワイルドカードを使用してファイルを一括コピー)
'/ ワイルドカードが使用できるのはファイル名のみです
'/ sfol1 : コピー元ファイル
'/ sfol2 : コピー先フォルダ
'/*********************************************
Private Function CopyFileUsingFSO2(ByVal sfol1 As String, ByVal sfol2 As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
'//初期値Falseを設定
CopyFileUsingFSO2 = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//[コピー元]・[コピー先]・[ファイルが存在する場合は上書き]でコピー
'//対象は拡張子が".txt"のファイル
myfso.CopyFile sfol1 & "¥*.txt", sfol2 & "¥", True
'//ファイルを移動する場合はMoveFileを使用する
'//myfso.MoveFile sfol1 & "¥*.txt", sfol2 & "¥"
CopyFileUsingFSO2 = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/*********************************************
'/ ファイル削除(FSOで指定ファイルを削除)
'/ サンプルとしてファイル名末尾の3桁の数値が10の倍数のファイルを削除
'/ sfol : ファイル格納フォルダ
'/*********************************************
Private Function DeleteFileUsingFSO(ByVal sfol As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
Dim strbuf As String, strtmp As String
'//初期値Falseを設定
DeleteFileUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//フォルダ内のファイルを取得して対象なら削除する
strbuf = Dir(sfol & "¥*.txt", vbNormal)
Do While strbuf <> ""
'ファイル末尾の3桁の数値を取得
strtmp = Replace(Right(strbuf, Len(strbuf) - InStrRev(strbuf, "_")), ".txt", "")
'10の倍数か判定
If IsNumeric(strtmp) = False Then GoTo LblNextRecord
If (CInt(strtmp) Mod 10) = 0 Then
'ファイルを削除(読み取り専用属性ファイルを削除)(詳細はDeveloperNetwork参照)
myfso.DeleteFile sfol & "¥" & strbuf, True
End If
LblNextRecord:
strbuf = Dir()
Loop
'//フォルダを作成する
DeleteFileUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
'/ ファイル削除(FSOで指定ファイルを削除)
'/ サンプルとしてファイル名末尾の3桁の数値が10の倍数のファイルを削除
'/ sfol : ファイル格納フォルダ
'/*********************************************
Private Function DeleteFileUsingFSO(ByVal sfol As String) As Boolean
On Error GoTo LblError
Dim myfso As Object
Dim strbuf As String, strtmp As String
'//初期値Falseを設定
DeleteFileUsingFSO = False
'//FSOオブジェクトを取得する
Set myfso = CreateObject("Scripting.FileSystemObject")
'//フォルダ内のファイルを取得して対象なら削除する
strbuf = Dir(sfol & "¥*.txt", vbNormal)
Do While strbuf <> ""
'ファイル末尾の3桁の数値を取得
strtmp = Replace(Right(strbuf, Len(strbuf) - InStrRev(strbuf, "_")), ".txt", "")
'10の倍数か判定
If IsNumeric(strtmp) = False Then GoTo LblNextRecord
If (CInt(strtmp) Mod 10) = 0 Then
'ファイルを削除(読み取り専用属性ファイルを削除)(詳細はDeveloperNetwork参照)
myfso.DeleteFile sfol & "¥" & strbuf, True
End If
LblNextRecord:
strbuf = Dir()
Loop
'//フォルダを作成する
DeleteFileUsingFSO = True
Exit Function
LblError:
'//Falseで戻る
End Function
よろしければポチッと押してください