| ■13355 / 親階層) |
ファイルリネームマクロ
|
□投稿者/ たくろう -(2019/02/26(Tue) 11:10:20)
| いつもお世話になっております。
ファイルリネームのマクロを作りましたが、うまくいきません。
フォルダ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に変更したものが入るようにしています。
どうぞ宜しくお願い致します。
|
|
ファイルリネームマクロ
/ たくろう (19/02/26(Tue) 11:10) #13355 ←Now
上記ツリーを一括表示 / 上記ツリーをトピック表示