◆オブジェクトを使用した File / Folder のコピー

  FileオブジェクトやFolderオブジェクトを使用してコピーをする方法を紹介します。

  Copyメソッドの構文は
  
  object.Copy destination[, overwrite]

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

  ファイルの名前やフォルダの名前を変更してコピーすることもできます。
  サンプル を参照してください。

  上書きを許す場合は、overwrite のところで True を記述します。省略すると False を
  設定したことになります。

Sub FileCopy()

    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 & "\"

    'ファイルのコピー
    File_Object.Copy FolderSpec

    'フォルダのパスにファイル名を追加
    FolderSpec = FolderSpec & "temp.xls"

    '名前を変更してファイルのコピー
    File_Object.Copy FolderSpec

End Sub

Sub FolderCopy()

    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)

    'SourcFolderSpec内の全ファイルをDestFolderSpecにコピー
    'サブフォルダも対象になります
    SourcFolder_Object.Copy DestFolderSpec

    'フォルダのパスの最後に "\" を追加します
    DestFolderSpec = DestFolderSpec & "\"
    
    'SourcFolderSpecをDestFolderSpecのサブフォルダとしてコピー
    SourcFolder_Object.Copy DestFolderSpec
    
    'フォルダのパスに新しいフォルダの名前を追加
    DestFolderSpec = DestFolderSpec & "NewFolder"
    
    'DestFolderSpeの下に"NewFolder"を作成してコピー
    SourcFolder_Object.Copy 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 をダウンロードして動作を確認してください。