« ubuntuインストール2日目 | トップページ | 画像をシート上に貼り付ける »

2010年3月 6日 (土)

フォルダー名の表示と変更(VBA)

フォルダー名を変更するのを1つ1つ行うのは面倒なので、WEBの情報を参考にして、マクロを作ってみた

01

Option Explicit

Sub フォルダ名取得()
Dim MyName
Dim MyPath
Dim i As Long

i = 1

' フォルダーを自由に選べること。 参考:officeTANAKA
  With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
         '   MsgBox .SelectedItems(1)
            If Len(.SelectedItems(1)) = 3 Then ' c:\の場合とサブフォルダーの場合
                MyPath = .SelectedItems(1)
                Else
                MyPath = .SelectedItems(1) & "\"
            End If
        End If
    End With

If MyPath = Empty Then MsgBox "フォルダー名表示をキャンセルしました。": Exit Sub

Range("a1").Value = "表示するフォルダー名の親フォルダー名"
Range("a2").Value = MyPath
Range("b2").Value = "現在のフォルダー名"
Range("c2").Value = "変更するフォルダー名"
Range("b2:c2").ShrinkToFit = True ' 縮小してセル内に表示

MyName = Dir(MyPath, vbDirectory)    ' 最初のフォルダ名を返します。

Do While MyName <> ""    ' ループを開始します。
    ' 現在のフォルダと親フォルダは無視します。
    If MyName <> "." And MyName <> ".." Then
        ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            Range("a" & i + 3) = MyPath & MyName ' アクティブシートA1セルから下方に表示。上書き。
            Range("b" & i + 3) = MyName
            i = i + 1
        End If
    End If
    MyName = Dir                    ' 次のフォルダ名を返します。
Loop

MsgBox MyPath & "の中にフォルダーは" & (i - 1) & "個のフォルダーがありました。"

End Sub

-----------------------------------

Sub フォルダー名の変更()
' Name "C:\Users\tmp.txt" As "C:\Users\tmp\tmp.txt"  ←移動となる。
' B列現在のフォルダー名 C列=新しいフォルダー名(入力要)
' OKキャンセルボタンとデフォルトアクティブボタンの設定は数値の加算で行う。
'   1              第2ボタン256 = 1+256 = 257
Dim i As Long
Dim atai As String

atai = MsgBox("B列フォルダー名がC列フォルダー名に変更されます!" & vbCrLf _
& "B,C列に値がなければ、処理は行いません。", 257, "フォルダー名変更")

If atai = vbCancel Then Exit Sub

i = 4   'subフォルダ名取得が4行目からフォルダー名を表示するため。

Do While Range("b" & i).Text <> ""

If Range("C" & i).Text <> "" Then  ' 新ファイル名がある場合のみ、名前変更を行う。
    Name Range("a2").Text & Range("b" & i).Text As Range("a2").Text & Range("c" & i).Text
End If

i = i + 1

Loop

End Sub

|

« ubuntuインストール2日目 | トップページ | 画像をシート上に貼り付ける »

「ExcelVBA」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)




« ubuntuインストール2日目 | トップページ | 画像をシート上に貼り付ける »