◆オブジェクトを使用した File / Folder の移動

  FileオブジェクトやFolderオブジェクトを使用して、移動をする方法を紹介します。

  Moveメソッドの構文は
  
  object.Move destination 

  です。
  
  ポイントはコピーと同様に移動先のパスの最後に、このフォルダーの中へ、という意味？
  で "\" を付け加えることです。

  ファイルの名前やフォルダの名前を変更して移動することもできます。
  サンプルはでは、名前を変えないで移動するのと、名前を変更して移動する両方を
  書いてありますが、名前を変える方をコメントにしてあります。

  動作させるときに、どちらかをコメントにして実行してください。
  

Sub FileMove()

    Dim FileType, Prompt As String
    Dim FolderSpec As String
    Dim File_Object, Duplicate_Object As Object
    Dim FileNamePath As Variant
    
    FileType = "すべての ﾌｧｲﾙ (*.*),*.*"
    Prompt = "File を選択してください"
    '操作したいファイルのパスを取得します
    FileNamePath = SelectFileNamePath(FileType, Prompt)

    If FileNamePath = False Then    'キャンセルボタンが押された
        End
    End If

    'Folder を選択します
    FolderSpec = FolderPath
    
    'キャンセルの場合は終了します
    If FolderSpec = "" Then
        End
    End If

    'ファイルオブジェクトを取得
    Set File_Object = CreateObject _
              ("Scripting.FileSystemObject").GetFile(FileNamePath)

    'フォルダのパスの最後に "\" を追加します
    FolderSpec = FolderSpec & "\"

' �@ �A どちらかをコメントにして実行してください

'-�@---------------------------------------------
    'ファイルの移動
    File_Object.Move FolderSpec

'------------------------------------------------


'-�A---------------------------------------------
'    名前を変更しての移動
'
'    'フォルダのパスにファイル名を追加
'    FolderSpec = FolderSpec & "temp.xls"
'
'    '名前を変更してファイルを移動する
'    File_Object.Move FolderSpec
'
'------------------------------------------------

End Sub

Sub FolderMove()

    Dim SourcFolderSpec, DestFolderSpec As String
    Dim SourcFolder_Object, DestFolder_Object As Object
    Dim FileNamePath As Variant
    

    'Source Folder を選択します
    SourcFolderSpec = FolderPath
    
    'キャンセルの場合は終了します
    If SourcFolderSpec = "" Then
        End
    End If

    'Destination Folder を選択します
    DestFolderSpec = FolderPath
    
    'キャンセルの場合は終了します
    If DestFolderSpec = "" Then
        End
    End If

    'フォルダオブジェクトを取得
    Set SourcFolder_Object = CreateObject _
              ("Scripting.FileSystemObject").GetFolder(SourcFolderSpec)

    'フォルダのパスの最後に "\" を追加します
    DestFolderSpec = DestFolderSpec & "\"
    
' �@ �A どちらかをコメントにして実行してください

'-�@--------------------------------------------------------
    'SourcFolderSpec内の全ファイルをDestFolderSpecへ移動
    SourcFolder_Object.Move DestFolderSpec
    
'-----------------------------------------------------------


'-�A--------------------------------------------------------
    'フォルダの名前を変えて移動

'    'フォルダのパスに新しいフォルダの名前を追加
'    DestFolderSpec = DestFolderSpec & "NewFolder"
'
'    'DestFolderSpeの下に"NewFolder"を作成して移動
'    SourcFolder_Object.Move DestFolderSpec

'-----------------------------------------------------------
    
    
End Sub

Function SelectFileNamePath(FileType, Prompt) As Variant
  SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt)
End Function

Function FolderPath() As String
    
    Dim Shell As Object
    
    Set Shell = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "フォルダを選択してください", 0, "デスクトップ")
    
    If Shell Is Nothing Then
        FolderPath = ""
    Else
        FolderPath = Shell.Items.Item.Path
    End If

End Function

example25 をダウンロードして動作を確認してください。