| いつもお世話になっております。
ファイルリネームのマクロを作りましたが、うまくいきません。
フォルダ1:Excelファイルが入っている フォルダ2:PDFファイルが入っている
上記フォルダ内にあるファイルネームをマクロを保存したExcelに読み出し、 フォルダ内1番目のExcelのファイルネームをフォルダ内1番目のPDFファイルに付ける、 複数あれば繰り返す、 というマクロを作りました。
PDFファイルはスキャナーから取り込んだもので、 例えば100ページあったとしたら、 分割ソフトで2ページずつ50個のファイルにし、 分割したPDFファイルには1.pdf、2.pdf・・・50.pdfのように、 ファイルネームが付きます。
それをフォルダ1にあるExcelファイルネームを付けようとするのですが、 フォルダ2のpdfファイルを読み込む際、 1、2、3・・・の順ではなく、1、10、11・・・19、2、20、21・・・ というような順番で読み込んでしまい、 Excelとの並びが合わなくなってしまいます。 結果、2.pdfに付けたいファイルネームが10.pdfに付いてしまいます。
分割後のPDFファイルネームが01.pdf、02.pdfとなれば問題ないのですが、 そのような分割ソフトも見つかりませんし、 ファイル数が3桁になった場合はまた問題が発生してしまいます。 PDFファイルを1、2、3・・・の順に読み込ませる方法はあるでしょうか。
マクロ初心者故、このような質問の仕方で良いのかもわかりませんが、 作成したコードは下記の通りです。
Sub リネーム
Sheets("リネーム").Select Range("A7:B100").Select Selection.ClearContents Range("A7").Select
Dim fd_path As String Dim fl_name As String Dim i As Long
fd_path = 「フォルダ2」 fl_name = Dir(fd_path & "\*") If fl_name = "" Then MsgBox "ファイルが存在しません。": Exit Sub Range("B2").Value = fd_path
i = 7 ChDir fd_path & "\" Do Until fl_name = "" Cells(i, "A").Value = fl_name i = i + 1 fl_name = Dir Loop
'Dim fd_path As String 'Dim fl_name As String 'Dim i As Long
fd_path = 「フォルダ1」
fl_name = Dir(fd_path & "\*") If fl_name = "" Then MsgBox "ファイルが存在しません。": Exit Sub
i = 7 ChDir fd_path & "\" Do Until fl_name = "" Cells(i, "B").Value = fl_name i = i + 1 fl_name = Dir Loop Cells.Replace What:=".xlsx", Replacement:=".pdf", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False 'Dim i As Long
i = 7
Do Until Cells(i, 1).Value = "" FileCopy Range("B2").Value & "\" & Cells(i, 1).Value, _ Range("B3").Value & "\" & Cells(i, 2).Value i = i + 1 Loop
※セルB2にはフォルダ1のパス、 セルB3にはフォルダ2のパスが入っています。 また、セルA7〜A100にはフォルダ2のPDFファイルネーム(リネーム前)が入り、 セルB7〜B100にはフォルダ1のExcelファイルネームの拡張子を.xlsxから.pdfに変更したものが入るようにしています。
どうぞ宜しくお願い致します。
|