[[20230921102910]] 『ファイル名だけ上書きする処理で問題が』(動画ファン) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『ファイル名だけ上書きする処理で問題が』(動画ファン)

以下の続編となります
https://www.excel.studio-kazu.jp/kw/20230916143121.html

以下のコードで問題なく作動すると思ったのですが
ファイル名を分割して出力する場合(Ep01-05とEp06-11の2回に分けてコードを実行する場合)

最初のEP01-05の場合は良いのですが次のEp06-11の場合は
「 '-----以下は、ファイル名が文字化けするので改めてファイル名だけ上書きする処理」以降の処理では
ファイル名が最初(Ep01)から書き出す仕様になっているので
Ep06-11では無く最初のEp01から始まるEp01-06でファイル名が上書きで出力されてしまいます。

Ep06-11で出力される変更したいのですがどのようにコードを修正したら良いでしょうか?
コードを継ぎ足ししているので無駄や分かりにくい仕様となっていますがご勘弁ください。

なお途中にFanctionを呼び出すコードがありますが
相談内容とは直接関係ないので処理内容については無視しても問題ないと思います。

 Option Explicit

 Sub showMediaInfo()  'コマンドライン版のMediaInfoを利用

      Dim Itm As Variant
      Dim mDic As Dictionary
      Dim fd As FileDialog

      Const sht = "List"   '書き出すシート名はListに固定してあります。

      'シートの初期化
      Sheets(sht).Cells.Clear

      Application.ScreenUpdating = False

      'ファイルの複数選択をする
      Set fd = Application.FileDialog(msoFileDialogFilePicker)

      fd.Title = "調査する動画ファイルを選択してください。(同一フォルダーなら複数可)"
      With fd
            If .Show = -1 Then 'ダイアログ表示
                  For Each Itm In .SelectedItems
                        Set mDic = getMediaInfo(Itm)
                        Call writeShtMediaInfo(sht, mDic)
                  Next Itm
            Else 'キャンセルした時終了
                  MsgBox "処理は、キャンセルされました。", vbInformation
                  Exit Sub
            End If
      End With

      With Sheets(sht)
            .Cells(1, 1) = ""
            .Cells(1, 2) = "ファイル名"
            .Cells(1, 3) = "ファイルサイズ(GB)"
            .Cells(1, 4) = "再生時間"
            .Cells(1, 5) = "総ビットレート(kbps)"
            .Cells(1, 6) = "動画ビットレート(kbps)"
            .Cells(1, 7) = "動画(幅)"
            .Cells(1, 8) = "動画(高さ)"
            .Cells(1, 9) = "音声ビットレート(kbps)"
      End With

      Dim lcn As Long
      Dim i As Long

      lcn = Sheets(sht).Cells(Rows.Count, 1).End(xlUp).row

      For i = 2 To lcn '再生時間をhh:mm:ssで表示
            With Sheets(sht)
                  .Cells(i, 4) = Left(.Cells(i, 4), 8)
            End With
      Next

      'A列のパスは必要ないので削除
      Sheets(sht).Columns(1).Delete

      '-----以下は、ファイル名が文字化けするので改めてファイル名だけ上書きする処理
      Dim folderPath As Variant
      folderPath = fd.InitialFileName

      Dim fso As Object
      Dim folder As Object
      Dim file As Object
      Dim shell As Object

      Set fso = CreateObject("Scripting.FileSystemObject")
      Set folder = fso.GetFolder(folderPath)
      Set shell = CreateObject("Shell.Application")

      Dim varFolPath As Variant
      Dim objFld As Variant
      Dim bitrate As Long
      Dim row As Long

      varFolPath = folderPath

      Set objFld = shell.Namespace(varFolPath)

      row = 2

      'ファイル名をフォルダー内の全てのファイル名を書き出す(途中で「Exit For」で処理を抜け出す)
      For Each file In folder.Files
            If LCase(fso.GetExtensionName(file.path)) = "mp4" Then
                  Sheets(sht).Cells(row, 1) = file.Name  'ファイル名
                  row = row + 1
                  If row > lcn Then Exit For   '選択ファイル以上は書き出す必要が無いので処理終了
            End If
      Next

      '列幅自動調整
      Sheets(sht).Columns("A:L").AutoFit

      Application.ScreenUpdating = True

      Set fd = Nothing
      Set mDic = Nothing

 End Sub

< 使用 Excel:Excel2021、使用 OS:Windows11 >


以下に変更したらItem(1)で最初のEp06相当のファイル名が表示されました。
但しEp06>Ep07>------>Ep11のハズが全てEp06と同一名でした。
(Item(1)と「1」を指定したので当然だと思います。)

ローカルウインドゥを見ると
fdの中のSelectedItemsの更に中にある
Item 1,Item 2,Item 3.Item 4,Item 5,Item 6 の6個に
Ep6,--->Ep16のファイル名がそれぞれ6個格納されていました。

Item(1)をどのように書き換えたら上手く処理できますか?

 For Each file In folder.Files
                  Sheets(sht).Cells(row, 1) = fd.SelectedItems.Item(1) 'ファイル名
                  row = row + 1
                  If row > lcn Then Exit For   '選択ファイル以上は書き出す必要が無いので処理終了
 Next
(動画ファン) 2023/09/21(木) 13:21:55

 | なお途中にFanctionを呼び出すコードがありますが
 | 相談内容とは直接関係ないので処理内容については無視しても問題ないと思います。
 そうでしょうか。

 チラとコードを拝見したところでは、
 |   For Each Itm In .SelectedItems
 |         Set mDic = getMediaInfo(Itm)
 |         Call writeShtMediaInfo(sht, mDic)
 |   Next Itm
 において、Itmは対象ファイルのフルパスなのだから、
 writeShtMediaInfo(sht, mDic,Item) と Itemも引数として渡し、
 writeShtMediaInfoの処理の中で、
   ・ファイル名の個所だけ、
   ・mDicの情報を使わずに、Item経由のファイル名を書き出す
 ように修正すれば、
 事後的に、ファイル名を上書きする処理は必要ないと思われます。
 いかがですか。

 # 直近の発言は衝突しまして、読んでいません。

(xyz) 2023/09/21(木) 13:24:05


xyzさん、ありがとうございます。

Item(i)で変数を順番に渡すと言う方法で
何とか以下で処理はされるようになりました。
(Gotoで強引にFOR処理を抜け出すようなってしまいました。)

      'ファイル名をフォルダー内の全てのファイル名を書き出す(途中で「Exit For」で処理を抜け出す)
      For Each file In folder.Files
            For i = 1 To fd.SelectedItems.Count
                  Sheets(sht).Cells(row, 1) = fd.SelectedItems.Item(i) 'ファイル名
                  row = row + 1
                  If row > lcn Then GoTo WiteEnd   '選択ファイル以上は書き出す必要が無いので処理終了
            Next
      Next

WiteEnd:

'-----------------------------------------

素人から脱却を目指していますがxyzさんのアドバイスにある以下のアドバイスは
現在の私には難しい事なのでコードを教えていただければ嬉しいです。

>>writeShtMediaInfo(sht, mDic,Item) と Itemも引数として渡し、
>>writeShtMediaInfoの処理の中で、
>> ・ファイル名の個所だけ、
>> ・mDicの情報を使わずに、Item経由のファイル名を書き出す
>> ように修正すれば、
>> 事後的に、ファイル名を上書きする処理は必要ないと思われます。

(動画ファン) 2023/09/21(木) 14:57:57


 ItmをItemと誤記していました。

 writeShtMediaInfo(sht, mDic, Itm) と Itmも引数として渡し、

 writeShtMediaInfoプロシージャの中で、

 For i = LBound(ttl) To UBound(ttl)
     If  i  = ○  then      ' (○は何番目かという数値)
         パス名(=Itm変数)からファイル名をとりだす
         cl.Offset(0, i) =ファイル名
     Else
         cl.Offset(0, i) = mDic.Item(ttl(i))
     End IF
 Next

 「パス名からファイル名を取り出す」部分は、ネット検索して例えば下記を参照。
 http://officetanaka.net/excel/vba/tips/tips78.htm
 私は以上とします。
(xyz) 2023/09/21(木) 21:16:38

xyzさん、追加のアドバイスありがとうございました。

色々、試行錯誤しましたが
残念ながらコードを読み解けず完成しませんでした。

「パス名からファイル名を取り出す」部分は、判りましたが

以下が何のことやらの状態です。
>>' (○は何番目かという数値)

xyzさんは、退席されるとの事なので
とりあえずは、付け焼刃の自前の先のコードで我慢します。

(動画ファン) 2023/09/22(金) 10:29:24


 Function getMediaInfo の中で
 Set getMediaInfo = mDic 
 する直前に
 mDic("File name extension:General") = filepath
 すればいいのではないですか
(´・ω・`) 2023/09/22(金) 11:00:10

´・ω・`さん、参加いただきありがとうございます。

記載いただいた内容をコードに追加することは容易いなのですが
これをどういかすのかを考えてみましたが理解できませんでした。

現在のコードは、元になる基本の最初のコードがネット記事の
「動画や写真などのメディアファイルの情報を取得して一覧表にするマクロ Excel VBA」
をそのまま利用して、他から探してきたネットのコードを継ぎ足した後で
簡単なコードを私が付け焼刃して帳尻を合わせたようなコードなので
応用が利かない状態です。

´・ω・`さんの追加コードを現在のコードにどのように生かすのかもう少し
アドバイスいただけませんか。
(動画ファン) 2023/09/23(土) 09:49:16


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.