人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

以下のようなファイル名の変更方法を教えてください。解決したら、解決に役立った回答者の方たちに、合計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でもいいので できる方法があれば教えてください。



1184565843
●拡大する

●質問者: kenpo43
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:txt VBA ソフト タイトル テキスト
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● kopj
●2000ポイント

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

◎質問者からの返答

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

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

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

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

B1 .txt

C1

D1 デザイナー密着.txt

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

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


2 ● abaratomimi
●0ポイント

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

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

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

に変えてEnterを押します。

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

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

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

連番がつきます。

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


3 ● kopj
●0ポイント

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

とすればいいでしょう。


4 ● cx20
●1500ポイント

既に解決されているようなので、投稿しようか迷いましたが、一応、別の方法(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
◎質問者からの返答

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

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

追記

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ