複数の階層に別れた2000程のフォルダがあり、各フォルダの中にPDFファイルが入っています。

これらPDFファイルを同一フォルダ内に移動させ、『PDF→透明テキスト付きPDF』にOCR処理したいと考えています。

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

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

回答の条件
  • 1人5回まで
  • 登録:2010/01/27 11:49:13
  • 終了:2010/01/27 22:47:13

ベストアンサー

id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912010/01/27 15:26:38

ポイント100pt

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
id:and_sin

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

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

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

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

2010/01/27 22:44:06

その他の回答(2件)

id:hissssa No.1

hissssa回答回数423ベストアンサー獲得回数1272010/01/27 12:44:50

ポイント30pt

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

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

id:and_sin

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

2010/01/27 12:47:40
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692010/01/27 15:16:09

ポイント100pt

お手元に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列に"失敗"と表示します。

先の処理の同名で末尾に数字がついたファイルも元に戻ります。

うまく動かなかった場合はコメント欄をオープンしていただければ修正します。

id:and_sin

回答ありがとうございました。

こんかいはMook様のバッチ処理で対応させていただきましたが、SALINGER様のVBAも大変わかり易く素晴らしい内容です。

今後利用する機会が有ると思いますので、大切に保存させて頂きます。

2010/01/27 22:45:56
id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912010/01/27 15:26:38ここでベストアンサー

ポイント100pt

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
id:and_sin

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

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

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

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

2010/01/27 22:44:06

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません