[[20150116141706]]　『リネームマクロ』（ゆーじ）　ページの最後に飛ぶ

『リネームマクロ』（ゆーじ）

はじめまして、なかなかうまくできないためご質問させていただきます。

リネームで下記のマクロを使っているのですが、
フォルダでも使えるようにすることはできないでしょうか？

'ファイル一覧作成
Sub ファイル一覧作成()
Dim FileName As String
Dim i As Long

If Range("B2").Value = "" Then

    MsgBox "コピー元のフォルダ名を入力してください。"
    Exit Sub
End If

i = 7
FileName = Dir(Range("B2").Value & "\*.xls")
Do Until FileName = ""

    Cells(i, 1).Value = FileName
    FileName = Dir()
    i = i + 1

Loop

MsgBox "ファイル名一覧を作成しました。"

End Sub

Sub ファイル名をまとめて変更する()
'アクティブシートのA列に入力されているファイル名を
'B列に入力されているファイル名に変更する
'
'B2セルに、ファイル名を変更したいフォルダのフルパスを入力しておいてください
'A6セル以下に、現在のファイル名を入力しておいてください
'B6セル以下に、新しいファイル名を入力しておいてください
'C6セル以下には実行結果が自動的に入力されます

  Dim fp As String
  Dim i As Long
  Dim fo As String
  Dim fn As String

  'パスを変数に格納
  fp = Range("B2").Value & "\"

  On Error GoTo ERR_HANDL

  Range("C6").Value = "実行結果"

  '7行目から最終行までループ処理を実行
  For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
    '現在のファイル名を取得
    fo = Cells(i, 1).Value
    '新しいファイル名を取得
    fn = Cells(i, 2).Value
    '新しいファイル名が入力されているときのみ処理を実行
    If fn <> "" Then
'正常処理の実行結果を先に入力
      Cells(i, 3).Value = _
        "○ファイル名を" & _
        "「" & fo & "」から" & _
        "「" & fn & "」に変更しました。"
      'ファイル名を変更
      Name fp & fo As fp & fn
    End If
  Next i

  Exit Sub

ERR_HANDL:

  Cells(i, 3).Value = _
    "×" & Err.Description & ":" & Err.Number
  Resume Next

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 ps = ThisWorkbook.Path
 With CreateObject("Scripting.FileSystemObject")
    If .FolderExists(ps & "\旧フォルダ名") Then
       .GetFolder(ps & "\旧フォルダ名").Name = "新しいフォルダ名"
    End If
 End With
 あまし検証してないけど。（カレントディレクトリなど）
 BJ

ＢＪさん
ありがとうございます！

マクロ初心者でごめんなさい
これはどこに入れたらいいのでしょうか？？
（ゆーじ） 2015/01/16(金) 15:54

 横から失礼。

 どこにいれたら・・・・？
 たとえばそちらでアップしたコードは、どこに書いているのかな？
 もしかして、そちらでアップしたコードの、どこかに入れようということ？
 でも、アップしたコードはファイル名の一括変換でしょ？　今回は全く別物で
 フォルダ名の変換ですよね。
 かつ、BJさんがアップしたコードは、エッセンス部分のみだから、当然、前後に
 マクロとして成り立つ、いろんなものを追加しなきゃいけませんよ・・・

 ついでに（？）別処理案というかFSOを使わない例を。
 標準モジュールに。フォルダダイアログがでるので名前を変更したいフォルダを選び
 次に、新しい名前の入力画面がでます。

 Sub Test()

    Dim hPath As String
    Dim tmp As Variant
    Dim hName As String
    Dim oName As String
    Dim nName As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then hPath = .SelectedItems(1)
    End With

    If Len(hPath) = 0 Then Exit Sub

    tmp = Split(hPath, "\")
    oName = tmp(UBound(tmp))
    hName = Left(hPath, Len(hPath) - Len(oName))

    nName = InputBox("新しいフォルダ名をいれてください")

    If Len(nName) = 0 Then Exit Sub

    If Len(Dir(hName & nName, vbDirectory)) > 0 Then
        MsgBox "すでに同名のフォルダが存在します"
        Exit Sub
    End If

    Name hName & oName As hName & nName

 End Sub

（β） 2015/01/16(金) 21:20

βさん

ありがとうございます。
ファイルやフォルダの量が多い為、
エクセル上で、フォルダ内のファイル名の一覧を作成、Ａ7以降に一覧、Ｂ7以降に変更名を入れるというものを作っているのですが、それと同じように、フォルダも変更できないのかと思ったのですが。

（ゆーじ） 2015/01/19(月) 09:51

おはようございます

実際の処理はそうでしょうね。１つ１つ、私がアップしたような処理をやるくらいなら
エクスプローラで手作業処理をしたほうが早いですもんね。

アップしたコードはあくまで、処理部品を使ったサンプルというか参考コードです。
実際には　私のコードでいえば　Name hName & oName As hName & nName　
BJさんのコードで言えば　.GetFolder(ps & "\旧フォルダ名").Name = "新しいフォルダ名"
この１行でフォルダ名変換をしていますので
シート上の新旧情報をループ処理で抽出して、このコードにあたえることになります。

（β） 2015/01/19(月) 10:07

 他のファイルも出てしまいますけれど、ファイルもフォルダもリネームするのは
 Name でできますから、
 　　FileName = Dir(Range("B2").Value & "\*.xls") 
 を
 　　FileName = Dir(Range("B2").Value & "\*", vbDirectory)
 にしてどうでしょうか。

 Dir の特性に関しては、このあたりを読んでおくとよいかと思います。
http://officetanaka.net/excel/vba/tips/tips95.htm

 上記中にもありますが、 vbDirectory は vbDirectory + vbNormal と同じ意味なので、
 フォルダとファイルが列挙されます。
 フォルダだけだと誤解している方もいますので、老婆心ながら。
（Mook） 2015/01/19(月) 10:57

 B2に親フォルダパスが書かれているとして一例です。

 Sub Sample()
    Dim pPath As String
    Dim c As Range
    Dim oName As String
    Dim nName As String

    pPath = Range("B2").Value & "\"

    For Each c In Range("A7", Range("A" & Rows.Count).End(xlUp))
        oName = c.Value
        nName = c.Offset(, 1).Value

        If Len(Dir(pPath & oName, vbDirectory)) = 0 Then
            MsgBox oName & "が存在しません"
        ElseIf Len(Dir(pPath & nName, vbDirectory)) > 0 Then
            MsgBox nName & "は既に存在します"
        Else
            Name pPath & oName As pPath & nName
        End If
    Next

 End Sub

 なお、Mookさんのご指摘、「フォルダだけだと誤解している方もいますので、老婆心ながら。」
 今回のケース、識別子がないフォルダ名の指定による処理ですので、手を抜いてもいいかなと。

（β） 2015/01/19(月) 11:08

βさん
リネームをやりたがっているのがちょっと歳の行った方で、エクスプローラとかぜんぜんわからない方なんです。
なので、
フルパスを入れてボタンを押したら一覧の作成。
名前を入れてもう一つのボタンを押して変更を完了。

といった形にしたかったのです。
フリーソフトで落ちているんですがうちの会社そういうところからや、ＵＳＢ等の使用が禁止で…
どうにかマクロで組めないかと思ったのですが、マクロを全く使ったことがなく頭を抱えておりました。

Mookさん
さっそく試してみました！！ありがとうございます。
フォルダもちゃんと一覧に出てきました！
しかしいざネーム変更しようとしたところ、エラーが出て下記の部分が黄色くなっていました

FileCopy Range("B2").Value & "\" & Cells(i, 1).Value, Range("B3").Value & "\" & Cells(i, 2).Value

（ゆーじ） 2015/01/19(月) 11:13

 あら、リネームではなかったですか？
 FileCopy はフォルダに対しては出来ない操作です。
（Mook） 2015/01/19(月) 11:26

βさん
サンプルをありがとうございます！
こちら試してみます！

Mookさん
すいません。
ひとつ前の間違えたマクロでやっていました！

最終版で試したところちゃんと動きました！
本当にありがとうございます！！
（ゆーじ） 2015/01/19(月) 12:00

 先の最後のコメントは、βさんのコードとは何も関係がありませんので、
 気になられたようでしたらすみませんでした。

 参照先の田中さんのサイトですが、フォルダ名は . を含まないという処理をしていますが、
 フォルダ名にも . は使用できますし、ファイル名も拡張子はなくても良いので、名前だけ
 で判断するのはちょっと面倒な気がしました。

 FSO を使用するのが単純だと思いますが、Dir だけでやろうとすると、

 If Dir( fPath ) = "" And Dir( fPath, vbDirectory ) <> "" Then
     MsgBox fPath & "はフォルダです。"
 Else
     MsgBox fPath & "はファイルです。"
 End If

 のような感じでしょうか。

 ただDir をループで使用している間に、判定に Dir を使えないなど、不便が多いですね。
（Mook） 2015/01/19(月) 12:53

コメント返信：

[ 一覧(最新更新順) ]

[[20150116141706]] 『リネームマクロ』（ゆーじ） ページの最後に飛ぶ

[[20150116141706]]　『リネームマクロ』（ゆーじ）　ページの最後に飛ぶ