機能仕様:1、フォルダ選択
2、フォルダ再帰読み込み
3、フォルダ配下全部ファイル読み込み、処理(自分追加)、TXTログファイルをローカルに出力
' シートに追加された処理開始ボタン
'''Private Sub btn_Generate_Click()
If Len(inputFileFolder.Text) = 0 Then
Call MsgBox("入力フォルダを入力してください。", vbOKOnly + vbCritical)
Exit Sub
End If
Call mainPross(inputFileFolder.Text)
End Sub
' シートに追加されたファイル選択ボタン
Private Sub CommandButton1_Click()
Application.FileDialog(msoFileDialogFolderPicker).InitialFileName = inputFileFolder.Text
If Not Application.FileDialog(msoFileDialogFolderPicker).Show Then Exit Sub
inputFileFolder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End Sub
※シートにファイルパスを表示用のTEXTBOX追加必要、NAMEはinputFileFolder
モジュールを新規して、下記のソースを書き込み。
Option Explicit
Dim outSheet As Worksheet
Dim inputFileFolder As String
Dim path As String
Dim fileExFlg As Boolean
Dim SaveDir As String
Public Sub mainPross(inputFileFolderP As String)
Windows.Application.ScreenUpdating = False
SaveDir = "C:\log\"
' Set outSheet = ActiveSheet
inputFileFolder = inputFileFolderP
Call ExecEachFolder(inputFileFolder, "**")
End Sub
’入力ディレクトリ再帰して、全部ファイルを繰り返す。
Public Function ExecEachFolder(folderPath As String, kaku As String)
Application.ScreenUpdating = False
Dim FSO As New FileSystemObject
' フォルダ内のファイルを処理する
Dim fe As FILE
For Each fe In FSO.GetFolder(folderPath).Files
Dim folderNm As String
folderNm = Split(folderPath, "\")(UBound(Split(folderPath, "\")))
Dim fp As String: fp = fe.path
Dim en As String: en = LCase(FSO.GetExtensionName(fp))
’ファイル存在の場合、ファイルをOPENして、処理を行う
doBlogic fe.path
Set fe = Nothing
Next
' サブフォルダに再帰的に検索する
Dim fr As Folder
For Each fr In FSO.GetFolder(folderPath).SubFolders
Call ExecEachFolder(fr.path, kaku)
Set fr = Nothing
Next
Set FSO = Nothing
a1: Exit Function
End Function
’ファイルをOPENして、自分の業務処理ロジックを書く
Public Function doBlogic(filepath As String)
Dim myBook As Workbook
Dim mySheet As Worksheet
On Error GoTo 1
Dim c
For Each c In Range("k7" & ":" & "k" & Selection.End(xlDown).Row)
'業務処理(自分追加)
'ログ出力
WriteLog c.value
Next c
1:
End Function
' ログ→TXTファイル出力
Sub WriteLog(msg As String)
Dim FSO As Object, LOG As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
''ログファイルがなければ作ります
If dir(SaveDir, vbDirectory) = "" Then
MkDir SaveDir
End If
If FSO.FileExists("C:\log\SuccessReport.log") = False Then
FSO.CreateTextFile "C:\log\SuccessReport.log"
End If
''追記で開きます
Set LOG = FSO.OpenTextFile("C:\log\SuccessReport.log", 8)
''日時+タブ+メッセージを書き込みます
LOG.WriteLine Now & vbTab & msg
Set LOG = Nothing
Set FSO = Nothing
End Sub