人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

複数の階層に別れた2000程のフォルダがあり、各フォルダの中にPDFファイルが入っています。
これらPDFファイルを同一フォルダ内に移動させ、『PDF→透明テキスト付きPDF』にOCR処理したいと考えています。

OCR処理が終わったPDFを元のフォルダに移動させたいのですが、良い方法は無いでしょうか。

ファイルを一つのフォルダに移動させる前に、元のフォルダ位置を記憶させておき、OCR処理後に元のフォルダにファイルを移動させることができ
るツールがあれば理想です。

●質問者: and_sin
●カテゴリ:コンピュータ
✍キーワード:OCR PDF PDFファイル テキスト ファイル
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● hissssa
●30ポイント

専用のツールはわかりませんが、移動・復元用のバッチファイルを作れば目的は達成されるかと思います。

コマンドプロンプトから、"dir /b /s *.pdf"とすれば、すべてのPDFファイルがフォルダ階層付のリストとして得られます。これをテキストファイルに保存しておいて、そこから移動・復元用バッチファイルを作ればいいでしょう。

◎質問者からの返答

『移動・復元用バッチファイル』はどのようにすれば作成できるのでしょうか?


2 ● SALINGER
●100ポイント

お手元に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
◎質問者からの返答

パーフェクトな回答です。素晴らしいスキルをお持ちで驚きました。

同名ファイルの存在も考慮して頂き、作業工数が大幅に圧縮されました。

僅かな情報でここまでして頂いて大変感謝しております。

本当にありがとうございました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ