advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 1215 for (Mook) (0.001 sec.)
[[20150116141706]]
#score: 9211
@digest: 3b6211b9bc9f809f5ac64b6f6c27d7fe
@id: 67044
@mdate: 2015-01-19T03:53:43Z
@size: 7855
@type: text/plain
#keywords: oname (35753), hpath (26361), nname (26119), hname (24651), ppath (17117), 旧フ (13347), vbdirectory (10512), リネ (8823), ダ名 (7567), 覧作 (6303), ォル (4676), ルダ (4004), フォ (3281), 行結 (3105), ル名 (3000), 婆心 (2977), 名") (2969), ネー (2857), ファ (2397), filename (2225), ル一 (2039), いフ (2011), ァイ (1856), ル以 (1759), イル (1553), 2015 (1459), dir (1318), 一覧 (1310), 誤解 (1174), アッ (1172), フル (1082), 月) (1057)
『リネームマクロ』(ゆーじ)
はじめまして、なかなかうまくできないためご質問させていただきます。 リネームで下記のマクロを使っているのですが、 フォルダでも使えるようにすることはできないでしょうか? 'ファイル一覧作成 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 ---- 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 ---- βさん ありがとうございます。 ファイルやフォルダの量が多い為、 エクセル上で、フォルダ内のファイル名の一覧を作成、A7以降に一覧、B7以降に変更名を入れるというものを作っているのですが、それと同じように、フォルダも変更できないのかと思ったのですが。 (ゆーじ) 2015/01/19(月) 09:51 ---- おはようございます 実際の処理はそうでしょうね。1つ1つ、私がアップしたような処理をやるくらいなら エクスプローラで手作業処理をしたほうが早いですもんね。 アップしたコードはあくまで、処理部品を使ったサンプルというか参考コードです。 実際には 私のコードでいえば Name hName & oName As hName & nName BJさんのコードで言えば .GetFolder(ps & "¥旧フォルダ名").Name = "新しいフォルダ名" この1行でフォルダ名変換をしていますので シート上の新旧情報をループ処理で抽出して、このコードにあたえることになります。 (β) 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 ---- βさん リネームをやりたがっているのがちょっと歳の行った方で、エクスプローラとかぜんぜんわからない方なんです。 なので、 フルパスを入れてボタンを押したら一覧の作成。 名前を入れてもう一つのボタンを押して変更を完了。 といった形にしたかったのです。 フリーソフトで落ちているんですがうちの会社そういうところからや、USB等の使用が禁止で… どうにかマクロで組めないかと思ったのですが、マクロを全く使ったことがなく頭を抱えておりました。 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 ...
https://www.excel.studio-kazu.jp/wiki/kazuwiki/201501/20150116141706.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97057 documents and 608292 words.

訪問者:カウンタValid HTML 4.01 Transitional