hiko-blog

VBA業務改善

MENU

pdfファイル 複製 vbs ( 新しい名前に番号登録する 追加 )

Option Explicit

' ドロップアウトするフォルダを指定します
Const sourceFolder = "Z:\Work\"

' 出力フォルダを指定します
Const outputFolder = "Z:\Work\"

Dim objFSO, objFolder, objFile
Dim shell, newName, fileName

' File System Object を作成します
Set objFSO = CreateObject("Scripting.FileSystemObject")

' 出力フォルダが存在しない場合は作成します
If Not objFSO.FolderExists(outputFolder) Then
    objFSO.CreateFolder(outputFolder)
End If

' ドロップアウトするフォルダ内のファイルを処理します
Set objFolder = objFSO.GetFolder(sourceFolder)
For Each objFile In objFolder.Files
    If LCase(objFSO.GetExtensionName(objFile.Path)) = "pdf" Then
        ' ファイル名から拡張子を除いた部分を取得します
        fileName = objFSO.GetBaseName(objFile.Name)
        

' 新しい名前に番号登録する
Dim Filenumber
Filenumber = InputBox("numberをインプットしてください:", "番号登録")


        ' 新しいファイル名を作成します
        newName = "name1_" & Filenumber & fileName & "_123.pdf"
        ' 新しいファイルを作成します
        CreateNewFile newName

        newName = "name2_" & Filenumber & fileName & "_123.pdf"
        ' 新しいファイルを作成します
        CreateNewFile newName
        
        ' 元のファイルを削除します
        objFSO.DeleteFile objFile.Path
    End If
Next

' 新しいファイルを作成する関数
Sub CreateNewFile(newFileName)
    Dim newFilePath
    ' 出力ファイルのパスを作成します
    newFilePath = outputFolder & newFileName
    ' 同名のファイルが存在する場合は削除します(上書き)
    If objFSO.FileExists(newFilePath) Then
        objFSO.DeleteFile newFilePath
    End If
    ' ファイルをコピーして新しいファイルを作成します
    objFSO.CopyFile objFile.Path, newFilePath
End Sub