『ファイル名だけ上書きする処理で問題が』（動画ファン）
以下の続編となります
https://www.excel.studio-kazu.jp/kw/20230916143121.html
以下のコードで問題なく作動すると思ったのですが
ファイル名を分割して出力する場合（Ep01-05とEp06-11の２回に分けてコードを実行する場合）
最初の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 ＞
ローカルウインドゥを見ると
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
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さんは、退席されるとの事なので
とりあえずは、付け焼刃の自前の先のコードで我慢します。
（動画ファン） 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.