Top > 気まぐれ日記 > 2007-03-21

PDFのファイル名をリネーム *

http://www.shirou.jp/blog1/?p=441

shirouさんとこでの話題。

私はPDFの内部プロパティのタイトル名を取得し、ファイル名をリネームするvbsを書いて半自動化しています。
タイトルがちゃんと入っていないPDFファイルには使えないけど...

要Acrobat(Readerじゃないやつ、Elements不可)
拡張子vbsにして、ドラッグドロップで実行。

Set FSO = CreateObject("Scripting.FileSystemObject")
Set PDDoc = CreateObject("AcroExch.PDDoc")
Set Args = WScript.Arguments
For i = 0 to Args.Count - 1
    FullName = Args(i)
    If FSO.FileExists(FullName) And (LCase(FSO.GetExtensionName(FullName)) = "pdf") Then
        FileName = FSO.GetFileName(FullName)
        PathName = FSO.GetParentFolderName(FullName)
        PDDoc.Open FullName
        Title = Trim(PDDoc.GetInfo("Title"))
        PDDoc.Close
        If Title <> "" Then 
            NewFileName = Title & ".pdf"
        Else
            NewFileName = FileName
        End If
        NewFileName = Trim(InputBox("新しいファイル名", FileName, NewFileName))
        If NewFileName <> "" Then
            NewFileName = Replace(NewFileName, """", "”")
            NewFileName = Replace(NewFileName, "\", "¥")
            NewFileName = Replace(NewFileName, "/", "/")
            NewFileName = Replace(NewFileName, ":", ":")
            NewFileName = Replace(NewFileName, "*", "*")
            NewFileName = Replace(NewFileName, "<", "<")
            NewFileName = Replace(NewFileName, ">", ">")
            NewFileName = Replace(NewFileName, "|", "|")
            If NewFileName <> FileName Then
                Set File = FSO.GetFile(FullName)
                File.Name = NewFileName
                Set File = Nothing
            End If
        End If
    End If
Next
Set PDDoc = Nothing
Set FSO = Nothing

ショートカットを作るだけなら、こんな感じかな。
自宅にAcrobatがないので未確認。

Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set PDDoc = CreateObject("AcroExch.PDDoc")
Set Args = WScript.Arguments
For i = 0 to Args.Count - 1
    FullName = Args(i)
    If FSO.FileExists(FullName) And (LCase(FSO.GetExtensionName(FullName)) = "pdf") Then
        FileName = FSO.GetFileName(FullName)
        PathName = FSO.GetParentFolderName(FullName)
        PDDoc.Open FullName
        Title = Trim(PDDoc.GetInfo("Title"))
        PDDoc.Close
        NewFileName = Title & "(" & FileName & ")"
        NewFileName = Trim(InputBox("ショートカット名", FileName, NewFileName))
        If NewFileName <> "" Then
            NewFileName = Replace(NewFileName, """", "”")
            NewFileName = Replace(NewFileName, "\", "¥")
            NewFileName = Replace(NewFileName, "/", "/")
            NewFileName = Replace(NewFileName, ":", ":")
            NewFileName = Replace(NewFileName, "*", "*")
            NewFileName = Replace(NewFileName, "<", "<")
            NewFileName = Replace(NewFileName, ">", ">")
            NewFileName = Replace(NewFileName, "|", "|")
            With Shell.CreateShortCut(FSO.BuildPath(PathName ,NewFileName & ".lnk"))
                .TargetPath = FullName
                .WorkingDirectory = PathName
                .Save
            End With
        End If
    End If
Next
Set PDDoc = Nothing
Set FSO = Nothing
Set Shell = Nothing

TOSHIBA VARDIA *

いま買うならこの辺かな?