FileSystemObjectでのファイル・フォルダ名称一括変更(VBA-Excel) скачать в хорошем качестве

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 /// ---