ファイル移動のマクロ、FSOの不使用と使用を比較

ファイル移動のマクロの紹介です。まずは、FSO不使用は以下です。

'**************************************************
'* ファイルの移動
'* 移動先のフォルダが存在しない場合は作成
'* 移動元のファイルが存在しない場合は、メッセージを表示させて終了
'* 移動先に同名のファイルが存在する場合は、上書きするかどうか確認する
'* sourceFilePath:移動元のファイルのフルパス
'* destinationFolder:移動先のフォルダ
Sub MoveFileToSentFolder(ByVal sourceFilePath As String, ByVal destinationFolder As String)
    
    ' 移動元のファイルが存在するか確認
    Dim fileName As String
    fileName = Dir(sourceFilePath)
    If fileName = "" Then
        MsgBox "移動元のファイルが見つかりません。", vbExclamation
        Exit Sub
    End If

    ' 移動先のファイルパスを設定
    Dim destinationFilePath As String
    destinationFilePath = destinationFolder & "\" & fileName
    
    ' 移動先のフォルダが存在しない場合は作成
    If Dir(destinationFolder, vbDirectory) = "" Then
        MkDir destinationFolder
    End If

    ' 移動先に同名のファイルが存在するか確認
    If Dir(destinationFilePath) <> "" Then
        ' 同名のファイルが存在する場合は確認メッセージを表示
        If MsgBox("移動先に同名のファイルが既に存在します。上書きしますか?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
        Else
            ' 上書きを許可した場合は既存ファイルを削除
            Kill destinationFilePath
        End If
    End If

    ' ファイルを移動
    Name sourceFilePath As destinationFilePath
    MsgBox "ファイルを移動しました。", vbInformation
End Sub

使用例は、以下です。

' ファイル"H:\temp\NewFile.xlsx"を、フォルダ"H:\temp\移動先"に移動
Sub 使用例()
    Call MoveFileToSentFolder("H:\temp\NewFile.xlsx", "H:\temp\移動先")
End Sub

次に、FSOを使用した例です。

'**************************************************
'* ファイルの移動、FSO(FileSystemObject)を使用
'* 移動先のフォルダが存在しない場合は作成
'* 移動元のファイルが存在しない場合は、メッセージを表示させて終了
'* 移動先に同名のファイルが存在する場合は、上書きするかどうか確認する
'* sourceFilePath:移動元のファイルのフルパス
'* destinationFolder:移動先のフォルダ
Sub MoveFileToSentFolderFSO(ByVal sourceFilePath As String, ByVal destinationFolder As String)

    '■FileSystemObjectの宣言
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")

    ' 移動元のファイルが存在するか確認
    If Not fso.FileExists(sourceFilePath) Then
        MsgBox "移動元のファイルが見つかりません。", vbExclamation
        Exit Sub
    End If

    ' 移動先のファイルパスを設定
    Dim destinationFilePath As String
    destinationFilePath = destinationFolder & "\" & fso.GetFileName(sourceFilePath)

    ' 移動先のフォルダが存在しない場合は作成
    If Not fso.FolderExists(destinationFolder) Then
       fso.CreateFolder destinationFolder
    End If

    ' 移動先に同名のファイルが存在するか確認
    If fso.FileExists(destinationFilePath) Then
        ' 同名のファイルが存在する場合は確認メッセージを表示
        If MsgBox("移動先に同名のファイルが既に存在します。上書きしますか?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
        Else
            ' 上書きを許可した場合は既存ファイルを削除
            fso.DeleteFile destinationFilePath
        End If
    End If

    ' ファイルを移動
    fso.MoveFile sourceFilePath, destinationFilePath
    MsgBox "ファイルを移動しました。", vbInformation
End Sub

使用例は、以下です。

' ファイル"H:\temp\NewFile.xlsx"を、フォルダ"H:\temp\移動先"に移動
Sub 使用例FSO()
    Call MoveFileToSentFolderFSO("H:\temp\NewFile.xlsx", "H:\temp\移動先")
End Sub

Follow me!