FileSystemObjectでのファイル・フォルダ名称一括変更(VBA-Excel)

Описание: (D0011)mv【応用】(VBA-Excel)FileSystemObjectでのファイル・フォルダ名称一括変更
(動画の内容)
1.セル値の説明と操作対象フォルダの説明
2.プログラムを実行。動作内容を確認
3.VBA開発画面を立ち上げ概要を見る
4.ファイル名称変更プロシジャーを行ステップで実行
5.フォルダ名称変更プロシジャーを行ステップで実行
-----------------------------------
≪ソースプログラム≫
'「Module1」※.表示等一部ソース部分削除。
'定義(シート内)
Private Const mcstr区分 As String = "区分"
Private Const mcstr名前① As String = "名前①"
Private Const mcstr名前② As String = "名前②"
Private Const mcstr方向 As String = "方向"
'変数(シート内)
Private mlngCol区分 As Long
Private mlngCol名前① As Long
Private mlngCol名前② As Long
Private mlngCol方向 As Long
Private mlngRow行 As Long
'定数(VBA内)
Private Const mcstrフォルダ位置 As String = "※削除"
'変数(VBA内)
Private mstr区分 As String
Private mlng元名前 As String
Private mlng先名前 As String
Sub 変換実行()
Dim blnRunHit As Boolean
Dim MyRange As Range
Dim MyMeaasge As String
mlngCol区分 = Range("区分").Column
mlngRow行 = Range("区分").Row
mlngCol名前① = Range("名前①").Column
mlngCol名前② = Range("名前②").Column
mlngCol方向 = Range("方向").Column
For Each MyRange In Range("区分")
'(初期値設定)
blnRunHit = True
mlngRow行 = MyRange.Row
'(値確認)
If blnRunHit = True Then
If Not Cells(mlngRow行, mlngCol区分) = "ファイル" And _
Not Cells(mlngRow行, mlngCol区分) = "フォルダ" And _
Not Cells(mlngRow行, mlngCol区分) = "両方" Then
blnRunHit = False
End If
End If
If blnRunHit = True Then
If Trim(Cells(mlngRow行, mlngCol名前①)) = "" Or _
Trim(Cells(mlngRow行, mlngCol名前②)) = "" Then
blnRunHit = False
End If
End If
If blnRunHit = True Then
If Not Cells(mlngRow行, mlngCol方向) = "→" And _
Not Cells(mlngRow行, mlngCol方向) = "←" Then
blnRunHit = False
End If
End If
'(処理プロシジャーコール)
If blnRunHit = True Then
If Cells(mlngRow行, mlngCol方向) = "→" Then
mlng元名前 = Cells(mlngRow行, mlngCol名前①)
mlng先名前 = Cells(mlngRow行, mlngCol名前②)
Else
mlng元名前 = Cells(mlngRow行, mlngCol名前②)
mlng先名前 = Cells(mlngRow行, mlngCol名前①)
End If
mstr区分 = Cells(mlngRow行, mlngCol区分)
Select Case mstr区分
Case "ファイル"
Call ファイル名称の置換え処理実行
Case "フォルダ"
Call フォルダ名称の置換え処理実行
Case Else
Call ファイル名称の置換え処理実行
Call フォルダ名称の置換え処理実行
End Select
End If
Next
End Sub
///
Function フォルダ名称の置換え処理実行()
Dim strFolderPath As String
Dim fs As Object
Dim FdlObj As Object
Dim MyObj As Object
Dim MyFromName As String
Dim MyToName As String
Dim MyStr As String
Dim lngCount件 As Long
glngFolder件数Read = 0
glngFolder件数Write = 0
glngFolder件数Error = 0
MyFromName = mlng元名前
MyToName = mlng先名前
'読込みファイル件数をセット。
Set fs = CreateObject("Scripting.FileSystemObject")
strFolderPath = mcstrフォルダ位置
Set FdlObj = fs.GetFolder(strFolderPath)
lngCount件 = FdlObj.subFolders.Count
If Not lngCount件 = 0 Then
For Each MyObj In FdlObj.subFolders
MyStr = Replace(MyObj.Name, MyFromName, MyToName)
If Not MyStr = MyObj.Name Then
glngFolder件数Read = glngFolder件数Read + 1
'Errorはスキップ
On Error Resume Next
Err.Clear
MyObj.Name = MyStr
On Error GoTo 0
End If
Next
End If
End Function
///
Function ファイル名称の置換え処理実行()
Dim strFolderPath As String
Dim fs As Object
Dim FdlObj As Object
Dim MyObj As Object
Dim MyFromName As String
Dim MyToName As String
Dim MyStr As String
Dim lngCount件 As Long
glngFile件数Read = 0
glngFile件数Write = 0
glngFile件数Error = 0
MyFromName = mlng元名前
MyToName = mlng先名前
'読込みファイル件数をセット。
Set fs = CreateObject("Scripting.FileSystemObject")
strFolderPath = mcstrフォルダ位置
Set FdlObj = fs.GetFolder(strFolderPath)
lngCount件 = FdlObj.Files.Count
If Not lngCount件 = 0 Then
For Each MyObj In FdlObj.Files
'
MyStr = Replace(MyObj.Name, MyFromName, MyToName)
If Not MyStr = MyObj.Name Then
glngFile件数Read = glngFile件数Read + 1
'Errorはスキップ
On Error Resume Next
Err.Clear
MyObj.Name = MyStr
On Error GoTo 0
End If
'
Next
End If
End Function
///
---