ファイル移動のマクロ、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