1184565843 以下のようなファイル名の変更方法を教えてください。解決したら、解決に役立った回答者の方たちに、合計1500~2000ポイントを配分します。


右写真のように、テキストファイルと、mpgファイルが1組ずつあります。つまり、仕事プロフェッショナル??-??のtxtファイルとmpgファイルが1組ずつあります。
そして、それぞれの仕事プロフェッショナルのtxtファイルの5行目には
「デザイナー密着4カ月」
のように、その番組のタイトルがあります。
 この5行目の文章をそれに対応したmpgファイルのファイル名にしたいのです。

 たとえば、仕事プロフェッショナル06-05なら次のようにしたいのです。
仕事プロフェッショナル06-05.mpg 
仕事プロフェッショナル06-05.txtから
「デザイナー密着4カ月」.mpg
「デザイナー密着4カ月」.txt
のようにしたいのです。


 それで、上記作業をなるべく簡単に早くしたいと思います。
 写真にはいくつかのファイルしかありませんが、他にファイルが1000個ほどあるので、手作業でやるのは厳しいです。

上のようなファイル名変更を ソフト vbaでもいいので できる方法があれば教えてください。

回答の条件
  • 1人2回まで
  • 登録:2007/07/16 15:04:05
  • 終了:2007/07/16 19:03:42

回答(4件)

id:kopj No.1

kopj回答回数123ベストアンサー獲得回数62007/07/16 15:47:10

ポイント2000pt

Sub Macro1()

'

' Macro1 Macro

'

'

'A列 名前

'B列 種類 ← 以下を 実際に使用しているものに変更してください。

a1 = "MPGファイル"

b1 = ".mpg"

a2 = "テキストファイル"

b2 = ".txt"

'C列 変換後ファイル名

'D列 存在チェック

'

'実行する前に、このエクセルファイルを保存してください。

'保存しないと正しく実行されないと思われます。

'このエクセルファイルが、あるところに リネームしたいファイルを置いてください。

'念のため、バックアップを お願いします。

'


For A = 1 To 65536 Step 2

If Range("A" & A) = "" Then Exit For

f1 = ThisWorkbook.Path + "\" + Range("a" & A)

If Range("B" & A) = a1 Then f2 = b1

If Range("B" & A) = a2 Then f2 = b2

If Dir(f1 & f2) = "" Then

Range("C" & A) = "存在しません"

GoTo next1:

End If

Range("C" & A) = "存在します"

If Range("A" & (A + 1)) = "" Then Exit For

f3 = ThisWorkbook.Path + "\" + Range("a" & (A + 1))

If Range("B" & (A + 1)) = a1 Then f4 = b1

If Range("B" & (A + 1)) = a2 Then f4 = b2

If Dir(f3 & f4) = "" Then

Range("C" & (A + 1)) = "存在しません"

GoTo next1:

End If

Range("C" & (A + 1)) = "存在します"

g1 = ""

If f2 = b2 Then g1 = f1 & f2

If f4 = b2 Then g1 = f3 & f4

If g1 = "" Then GoTo next1:

d = FreeFile

Open g1 For Input As #d

Line Input #d, aaa

Line Input #d, aaa

Line Input #d, aaa

Line Input #d, aaa

Line Input #d, aaa '5行目

Close #d

Range("D" & A) = aaa & f2

Range("D" & (A + 1)) = aaa & f4

Name f1 & f2 As ThisWorkbook.Path + "\" + aaa & f2

Name f1 & f4 As ThisWorkbook.Path + "\" + aaa & f4

'

next1:

Next A

End Sub

id:kenpo43

回答ありがとうございました。

早速ですが、わからない点があったのでお尋ねします。

具体的にどのセルに何を記載すればよいのかがわかりませんが、どのように記入していけばよいのでしょうか。

A1 仕事プロフェッショナル.txt

B1 .txt

C1

D1 デザイナー密着.txt

などいくつか考えられるのをやってみましたが、うまくいきませんでした。

 お手数ですが、セルの記入例を教えてもらえますでしょうか。

2007/07/16 16:57:56
id:abaratomimi No.2

abaratomimi回答回数371ベストアンサー獲得回数62007/07/16 16:18:42

1.更新日時順に並べ替えます

2.名前の部分を全部ドラッグして、右クリックで

  名前の変更を選択し、一番上を「デザイナー密着4カ月」

  に変えてEnterを押します。

3.デザイナー密着4カ月(1)

  デザイナー密着4カ月(2)

  デザイナー密着4カ月(3) と全てのファイル名が替わり

  連番がつきます。

http://www.vector.co.jp/vpack/filearea/win/util/file/name/index_...

id:kopj No.3

kopj回答回数123ベストアンサー獲得回数62007/07/16 17:34:51

5行目が 何もない場合に対応です。

Range("D" & A) = aaa & f2

Range("D" & (A + 1)) = aaa & f4

Name f1 & f2 As ThisWorkbook.Path + "\" + aaa & f2

Name f1 & f4 As ThisWorkbook.Path + "\" + aaa & f4

の部分を

if trim(aaa)<>"" then

Range("D" & A) = aaa & f2

Range("D" & (A + 1)) = aaa & f4

Name f1 & f2 As ThisWorkbook.Path + "\" + aaa & f2

Name f1 & f4 As ThisWorkbook.Path + "\" + aaa & f4

end if

とすればいいでしょう。

id:cx20 No.4

cx20回答回数607ベストアンサー獲得回数1082007/07/16 18:03:14

ポイント1500pt

既に解決されているようなので、投稿しようか迷いましたが、一応、別の方法(VBScript)ということで投稿します(せっかく作ったので・・・)


プログラムの概要としましては、

1. 指定したフォルダの *.txt を検索
2. テキストファイル内の「番組名」を取得
3. RENAME コマンドを画面(コンソール)に出力
 例)
 RENAME "仕事プロフェッショナル 06-05.mpg" "「デザイナー密着4カ月」.mpg"
 RENAME "仕事プロフェッショナル 06-05.txt" "「デザイナー密着4カ月」.txt"
 
 <番組名が空白だった場合、以下のコメント行を出力します>
 REM [xxxxxxxxxxxxxxxxxxx.txt] の番組名が正しく設定されていません。
4. 「1.」を繰り返す

という感じです。


プログラムは、「仕事プロフェッショナル??-??」の txt があるフォルダに

「MakeRenameCmd.vbs」という名前をつけて保存してください。


実行は、コマンドプロンプト(「ファイル名を指定して実行」にて「cmd」を実行)より

CScript MakeRenameCmd.vbs //Nologo > AllRename.cmd

とすると、リネーム用のバッチファイル「AllRename.cmd」が生成されます。


このバッチファイル実行すると、ファイル名のリネーム処理を一括で行います。

(処理を行う場合は、必ずバックアップをとって置いてから行ってください。)


' File : MakeRenameCmd.vbs
' Usage : CScript MakeRenameCmd.vbs //Nologo > AllRename.cmd
'
Option Explicit

' 仕事プロフェッショナル??-?? の txt があるフォルダを指定します
Const g_strTargetFolder = "C:\home\edu\hatena\kenpo43\1184565843\Data"
' 番組名の入っているファイルの拡張子を指定します
Const g_strTargetExt = "txt"

Const ForReading = 1

Dim g_fso ' FileSystemObject 用のグローバル変数

Call Main

Sub Main
    Set g_fso = CreateObject("Scripting.FileSystemObject")
    
    Call MakeRenameCmd
    
    Set g_fso = Nothing
End Sub

Sub MakeRenameCmd
    Dim folder
    Set folder = g_fso.GetFolder( g_strTargetFolder )
    
    Dim strBaseName    ' オリジナルのファイル名
    strBaseName = ""
    
    Dim strProgramName ' 番組名
    strProgramName = ""
    
    Dim file
    For Each file In folder.Files
        If g_strTargetExt = g_fso.GetExtensionName(file.Path) Then
            ' <ファイル名から拡張子を取り除く>
            ' [仕事プロフェッショナル 06-05.txt] → [仕事プロフェッショナル 06-05]
            strBaseName = g_fso.GetBaseName( file.Path )
            
            ' <テキストファイルから番組名を取得>
            ' [「デザイナー密着4カ月」]
            strProgramName = GetProgramNameFromTextFile( file.Path ) 
            
            If Len(strProgramName) > 0 Then
                ' <*.mpg のリネームコマンドを生成>
                ' [RENAME "仕事プロフェッショナル 06-05.mpg" "「デザイナー密着4カ月」.mpg"]
                WScript.Echo "RENAME """ & strBaseName & ".mpg"" """ & strProgramName & ".mpg"""
                
                ' <*.txt のリネームコマンドを生成>
                ' [RENAME "仕事プロフェッショナル 06-05.txt" "「デザイナー密着4カ月」.txt"]
                WScript.Echo "RENAME """ & strBaseName & ".txt"" """ & strProgramName & ".txt"""
            Else
                WScript.Echo "REM [" & file.Path & "] の番組名が正しく設定されていません。"
            End If
        End If
    Next
    
    Set folder = Nothing
End Sub

' テキストファイルから番組名を取得する関数
Function GetProgramNameFromTextFile( strFileName )
    Dim file
    Set file = g_fso.OpenTextFile( strFileName, ForReading)

    Dim nLine
    nLine = 5 ' 取得するデータ(番組名)がある行数
    
    Dim i
    For i = 1 To nLine - 1
        file.ReadLine       ' 1~(N-1)行を読み飛ばす
    Next
    
    Dim strLine
    strLine = file.ReadLine ' N行目のデータを取得する
    strLine = Trim(strLine) ' 前後の空白除去
    file.Close
    Set file = Nothing
    
    GetProgramNameFromTextFile = strLine
End Function
id:kenpo43

ありがとうございました。

すでにkopjさまに2000ポイントを配分は決定しているのですが、cx20さまの回答はそれとは別に考慮して相応のポイントを贈呈します。

追記

すごく役立ちました。(^_^)

kopjさまとは別に1500pt贈呈します。

2007/07/16 19:00:54
  • id:daiyokozuna
    http://www.vector.co.jp/vpack/browse/pickup/pw6/pw006435.html
  • id:kopj
    あ、
    'C列 変換後ファイル名

    'D列 存在チェック


    これ 逆になっちゃいました。


    'C列 存在チェック
    'D列 変換後ファイル名

    です。
  • id:kopj
    問題があれば教えてください。
  • id:kenpo43
    回答ありがとうございました。

    早速ですが、わからない点があったのでお尋ねします。
    具体的にどのセルに何を記載すればよいのかがわかりませんが、どのように記入していけばよいのでしょうか。

    A1 仕事プロフェッショナル.txt
    B1 .txt
    C1
    D1 デザイナー密着.txt

    などいくつか考えられるのをやってみましたが、うまくいきませんでした。
     お手数ですが、セルの記入例を教えてもらえますでしょうか。
  • id:kopj
    ええと 質問にあった図を エクセルファイルに 置き換えた上で実行できるようにしてあります。

    つまりA列は 名前で B列は 種類

    図にあったままで 実行できるようになっています。


    なお、データは1行目からです。
  • id:kopj
    A1に 仕事プロフェッショナル 03-08
    B1に MPGファイル
    A2に 仕事プロフェッショナル 03-08
    B2に テキストファイル

    というようにして実行します。

    仕事プロフェッショナル 03-08.mpgと
    仕事プロフェッショナル 03-08.txtが 存在しないと
    存在しませんと出ます。

    C列とD列は 何も書かなくていいです。
    結果が出るだけですから。
    mpgのファイルが存在しないと 次のmpgファイルをチェックします。
  • id:kenpo43
    お返事ありがとうございました。
    うまくいきました<(_ _)>

     しかし、私の方でミスがありました。
    テキストファイルの5行目が空白の場合があり、その時にこのマクロだと
    エラーが出てしまいます。

    そこで、5行目が空白の場合には、元のファイル名のままにして、処理を続けるようにしてもらえますでしょうか。(^^;)


     
  • id:kopj
    修正する部分だけ 回答しました。

    あと今、気がついたのですが、変更するファイル名が 既に存在する場合は エラーになっちゃうと思います。
  • id:kenpo43
    修正ありがとうございました。

    元のファイル名のまま、次の処理に進むには
    if trim(aaa)<>"" then

    Range("D" & A) = aaa & f2

    Range("D" & (A + 1)) = aaa & f4

    Name f1 & f2 As ThisWorkbook.Path + "\" + aaa & f2

    Name f1 & f4 As ThisWorkbook.Path + "\" + aaa & f4

    end if
    で、
    Range("D" & A) = aaa & f2

    Range("D" & (A + 1)) = aaa & f4

    Name f1 & f2 As ThisWorkbook.Path + "\" + aaa & f2

    Name f1 & f4 As ThisWorkbook.Path + "\" + aaa & f4
    を削除しましたら、うまくいきました。

    まだ、実際に全てのファイル名を変更を完了したわけではありませんが、これで、今回の疑問は解決しました。

    お返事も迅速で、本当にお世話になりました。
    質問冒頭の2000ポイント全部をkopjさまに後ほど贈呈します。
  • id:mass3
    2000ポイントの配分決まっちゃったのか~。
    でもせっかく作ったから解答してみます。
    回答書いていたら締め切られてしまったあ;;
    Javaで作りました。ソースも入れてあります。

    http://ind.s284.xrea.com/rename/

    たぶんkenpo43さんは今回1回だけじゃなくてまた使うこともあるだろうと思って何かを書き換えたりする必要なくマウスだけで操作できるようにしたのが特徴かな。
  • id:kenpo43
    わざわざありがとうございます。<(_ _)>
    後で見てみて、これから役に立ちそうならば100pt~1000ptの間で相応のポイントを送信します。
  • id:cx20
    大量のポイントありがとうございます。
    「はてな義援金」が始まりましたらそちらに送信しようかと思います。
    http://i.hatena.ne.jp/idea/16100
    http://d.hatena.ne.jp/hatenacontrib/
  • id:kenpo43
    ポイントが義援金に使われて、嬉しいです(^^)

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません