専用のツールはわかりませんが、移動・復元用のバッチファイルを作れば目的は達成されるかと思います。
コマンドプロンプトから、"dir /b /s *.pdf"とすれば、すべてのPDFファイルがフォルダ階層付のリストとして得られます。これをテキストファイルに保存しておいて、そこから移動・復元用バッチファイルを作ればいいでしょう。
『移動・復元用バッチファイル』はどのようにすれば作成できるのでしょうか?
お手元にExcelはありますでしょうか。
ExcelのVBAでPDFを収集するマクロと書き戻すマクロを書いてみました。
VBAとはなんぞやという場合は、こちらを参考にしてみてください。
http://www.officepro.jp/excelvba/ini/index1.html
http://www.officepro.jp/excelvba/ini/index2.html
http://www.officepro.jp/excelvba/ini/index3.html
標準モジュールに以下のコードをコピペすればいいです。
コードの最初の、2行は実際の環境に変更してください。
rootというのはPDFの入っているフォルダの一番上の階層のフォルダ
作業となっているのは集める為のフォルダです。
Const RootFolderPass = "C:\Documents and Settings\hogehoge\デスクトップ\root" Const MyFolderPass = "C:\Documents and Settings\hogehoge\デスクトップ\作業" Private FSO As Object Private r As Long Sub PDF収集() Set FSO = CreateObject("Scripting.FileSystemObject") r = 1 Cells.Clear Call getPDF(FSO.GetFolder(RootFolderPass)) Set FSO = Nothing End Sub Sub getPDF(fold As Object) Dim myFile As Object Dim myFold As Object Dim strName As String Dim i As Long Dim j As Integer For Each myFile In fold.Files If StrConv(Right(myFile.Name, 4), vbLowerCase) = ".pdf" Then Cells(r, 1).Value = myFile.Path strName = Left(myFile.Name, Len(myFile.Name) - 4) j = Len(strName) i = 0 While Not Range("B:B").Find(strName, lookat:=xlWhole, MatchCase:=False) Is Nothing i = i + 1 strName = Left(strName, j) & i Wend Cells(r, 2).Value = strName On Error Resume Next Call FSO.CopyFile(myFile.Path, MyFolderPass & "\" & strName & ".pdf") If Err.Number > 0 Then Cells(r, 3).Value = "失敗" On Error GoTo 0 r = r + 1 End If Next For Each myFold In fold.SubFolders Call getPDF(myFold) Next End Sub Sub PDF反映() Dim i As Long Dim lastRow As Long lastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lastRow If Cells(i, 3).Value <> "失敗" Then On Error Resume Next Call FSO.CopyFile(MyFolderPass & "\" & Cells(i, 2).Value & ".pdf", Cells(i, 1).Value, True) If Err.Number > 0 Then Cells(i, 4).Value = "失敗" On Error GoTo 0 End If Next End Sub
コードでは、PDF収集を実行するとPDFファイルを指定したフォルダに収集します。
(コピーにしてますので元のファイルは残ります)
ここでは同名のファイルが存在するときの為に、同名のファイルがあったら末尾に数字が入るようになっています。
ExcelのシートのA列に元のパス、B列にファイル名、C列には読み取り専用などで移動できない場合に"失敗"と表示するようにしています。
次に、OCR処理後にPDF反映を実行すると元の場所に上書きします。
上書きを失敗した場合は、D列に"失敗"と表示します。
先の処理の同名で末尾に数字がついたファイルも元に戻ります。
うまく動かなかった場合はコメント欄をオープンしていただければ修正します。
回答ありがとうございました。
こんかいはMook様のバッチ処理で対応させていただきましたが、SALINGER様のVBAも大変わかり易く素晴らしい内容です。
今後利用する機会が有ると思いますので、大切に保存させて頂きます。
▽3
●
Mook ●100ポイント ![]() |
VBS を使用した例です。
pdf ファイルがある最上位階層(そのフォルダ自身は対象外です。)で
下記を実行してください。
CopyAll.bat がファイルをコピーするバッチ、
CopyBack.bat がファイルを元にコピーするバッチです。
使用方法:
notepad 等に下記をコピーし拡張子を vbs で保存します。
Option Explicit '------------------------------------------------------- ' スクリプトがあるフォルダ下(サブフォルダも含む)のPDF ' ファイルをスクリプトのあるフォルダにコピーするバッチ・・・CopyAll.bat ' と、コピーしたファイルをコピーバックするバッチ・・・・・・CopyBack.bat ' を生成します。 '------------------------------------------------------- '------------------------------------------------------- ' コピー対象のファイルが重複なく、オリジナル名を使用する場合は useOriginalName = True にしてください。 ' コピー対象のファイルが重複する場合は useOriginalName = False にしてください。 '------------------------------------------------------- Const useOriginalName = False Public fso Set fso = CreateObject( "Scripting.FileSystemObject" ) Public cFolder Set cFolder = fso.getFile( WScript.ScriptFullName ). ParentFolder Public copyBat Set copyBat= fso.CreateTextFile( cFolder.Path & "\copyAll.bat" ) Public copyBackBat Set copyBackBat = fso.CreateTextFile( cFolder.Path & "\copyBack.bat" ) Public fileID fileID = 1 MakeFileList cFolder, True copyBat.Close copyBackBat.Close '------------------------------------------------------- Sub MakeFileList( rootFolder, isTop ) '------------------------------------------------------- Dim file, objName If isTop = False Then For Each file In rootFolder.Files If fso.GetExtensionName( file.Path ) = "pdf" Then If useOriginalName = True Then objName = file.Name Else objName = "WK_" & Right( "000000" & fileID, 6 ) & ".pdf" fileID = fileID + 1 End If copyBat.WriteLine "COPY /Y """ & file.Path & """ """ & cFolder.Path & "\" & objName & """" copyBackBat.WriteLine "COPY /Y """ & cFolder.Path & "\" & objName & """ """ & file.Path & """" End If Next End If Dim folder For Each folder In rootFolder.SubFolders MakeFileList folder, False Next End Sub
パーフェクトな回答です。素晴らしいスキルをお持ちで驚きました。
同名ファイルの存在も考慮して頂き、作業工数が大幅に圧縮されました。
僅かな情報でここまでして頂いて大変感謝しております。
本当にありがとうございました。