ファイルをコピーする ： Excel

Option Explicit

'ファイル選択ダイアログ
Public Function SelectFile_single()
    Dim sfile As String
    Dim i As Integer
    Dim s As String

    sfile = Application.GetOpenFilename("ファイルを選択してください (*.xls), *.xls")
    If sfile = "False" Then
        SelectFile_single = ""
    Else
        SelectFile_single = sfile
    End If
End Function

'フォルダ選択ダイアログ
Public Function SelectFolder_FileDialog()
    If Application.FileDialog(msoFileDialogFolderPicker).Show Then
        SelectFolder_FileDialog = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    Else
        SelectFolder_FileDialog = ""
    End If
End Function

'フルパスからファイル名のみ取得
Function GetFileName(fullpath As String) As String
    Dim i As Integer
    Dim nlen As Integer
    Dim s As String

On Error GoTo Errsub
    nlen = Len(fullpath)
    For i = nlen To 0 Step -1
        s = Mid$(fullpath, i, 1)
        If s = "\" Then Exit For
    Next
    s = Right$(fullpath, nlen - i)
    GetFileName = s
    Exit Function
Errsub:
    GetFileName = ""
End Function

Private Sub CommandButton1_Click()
    Range("E4") = SelectFile_single
End Sub

Private Sub CommandButton2_Click()
    Range("E8") = SelectFolder_FileDialog
End Sub

Private Sub CommandButton3_Click()
    Dim fname As String
    Dim sdir As String
       
    If Range("E4") = "" Then
        MsgBox "コピー元ファイルを選択してください。"
        Exit Sub
    End If
    
    If Range("E8") = "" Then
        MsgBox "コピー先フォルダを選択してください。"
        Exit Sub
    End If
        
    'パス名からファイル名のみ取り出し
    fname = GetFileName(Range("E4"))
    
    If Right(Range("E8"), 1) <> "\" Then
        sdir = Range("E8") & "\"
    Else
        sdir = Range("E8")
    End If
    
    'ファイルコピー
    FileCopy Range("E4"), sdir & fname
    MsgBox "ファイルをコピーしました。"
End Sub