実現したいこと
・子フォルダ内pdfファイル名を格納先親フォルダ名をキーにして、Excel（変換DB.xlsx）から情報取得しファイル名を変更するツールを作成したいです。
補足1：コードの流れは、パターン1、パターン2、パターン3を網羅したものを考えています。
※先日teratailにて質問した内容に対してやりたい事は変えず、一部方法を変更をしました。
URL https://teratail.com/questions/7t3o5dc7dz97ij
変更内容：Accessクエリから情報取得する部分を、Excel（変換DB.xlsx）から情報取得という形にしました。
●処理イメージ図
●処理前
●処理後
前提
・Excel（変換DB.xlsx）
共通キー：親フォルダ名（フォルダ名）＝社外購買番号（変換DB.xlsx）
共通キーからファイル名変更の情報を取得し、pdfファイル名を変更
・変換DB.xlsxの項目は、1つの社外購買番号に対して1つのファイル名変更のみ存在する条件になります。
画像では、C0001までですが、データは、D0001..等増えていく形になります。
桁数はすべて同じになります。
●変換DB.xlsx
●フォルダ構成
●ツール一覧フォルダ構成
ツールのコード流れ※処理イメージの詳細
＜パターン1＞
①.子フォルダ内のファイル件数取得
②.1つめファイルは親フォルダ名称をキーにして、変換DB.xlsxから該当ファイル名変更情報を取得
例.親フォルダ名：A0001なので、変換DBのA2からセル入力最終行間の同一セル（A0001）を照合しB列(202301-00010_A0001_株式会社山田)を取得
③.ファイル名を取得情報名に変更
例.202301-00010_A0001_株式会社山田.pdfとなる。
④.1つめファイルの為、ファイル名語尾に_00を追加し、ファイル名変更
例.202301-00010_A0001_株式会社山田_00.pdf
⑤.2つめファイルは、パターン1の上記②～④を繰り返す。2番目なのでファイル名語尾は_01となる
例.202301-00010_A0001_株式会社山田_01.pdf
＜パターン2＞
①.子フォルダ内のファイル名件数取得
②.1つめのファイル名に対して親フォルダ名が入るので、ファイル名変更無
例.B0001が入っている為、202302-00010_B0001_株式会社田中_00.pdfは変更しない。
③.2つめのファイル名に対して親フォルダ名が入らないので、パターン1の②～③の処理を行う。
例.202302-00010_B0001_株式会社田中.pdfとなる。
④.2つめファイルは、2番目なのでファイル名語尾は_01となる。
1つめのファイルに親フォルダ名がのっているため語尾名は、2つめという事で_01となる。
例.202302-00010_B0001_株式会社田中_01.pdf
＜パターン3＞
処理はパターン1、2と同じ。
変換DB.xlsxのファイル名変更情報の文字数がパターン1、2と違うという意味でのせました。
＜その他＞
・語尾のファイル名は、_00,_01,_02..._20でなくても、_0,_1,_2..._20でも問題ありません。
発生している問題・出来なかった事
1.Excel（変換DB.xlsx）から取得した情報とフォルダ名を照合し、ファイル名変更のやり方が全く分かりませんでした。
2.1の後から、条件にそったファイル名を変更する方法が全く分かりませんでした。
該当のソースコード
VBA
1Sub ファイル名変更() 2Const TargetFld As String = "C:\Users\○○○\Desktop\一時\テスト環境" 'フォルダ作成上位場所 3Const Copy = "C:\Users\z09071\Desktop\一時\ツール一覧" '変換DB.xlsx保管パス 4Const Cn As String = "変換DB.xlsx" 5Dim objFso As Object 6Dim objfld As Object 7Dim strFolderPath As String 8Dim swb As Workbook '変換DBファイル変数 9Dim sws As Worksheet '変換DBファイルシート変数 10Dim smaxrow As Long '変換DB最終行 11Dim a As Long '変換DB繰返し回数 12Dim sresult As String '変換DB社外購買番号 13 14Set objFso = CreateObject("Scripting.FileSystemObject") 15Set swb = Workbooks.Open(Copy & "\" & Cn) '変換DB.xlsxファイルを開く 16Set sws = swb.Worksheets("変換DB") 17smaxrow = sws.Cells(Rows.Count, "A").End(xlUp).Row '変換DBA列最終行 18For a = 2 To smaxrow '親フォルダ名と変換DB社外購買番号照合 19 20 21End If 22 23 24For Each objfld In Object.GetFolder(Target.Path & "\完了").SubFolders '親フォルダ内の完了フォルダ毎処理 25 26 27Next 28 29 30End Sub 31
試したこと
AccessからExcel（変換DB.xlsx）への転記はできたのですが、Excelから各ファイルに対してのファイル名変更ができませんでした。
補足情報（FW/ツールのバージョンなど）
ここにより詳細な情報を記載してください。
0 コメント