コピペで使えるVBAのコード置き場

ファイルをコピーする

筆箱にVBAのカンニングペーパーを入れる係のみすくです。こんにちは。
'---------------------------------------------------------------------------------------------------
'【処 理 名】ディレクトリパスへのセパレータ付与
'【処理概要】ディレクトリパスの末尾にセパレータがなければ付与する
'【引    数】[I]ByVal path As String ディレクトリパス
'【返 却 値】 なし
'---------------------------------------------------------------------------------------------------
Public Function AddPathSeparator(ByVal path As String) As String
    If Right(path, 1) <> ChrW(92) Then
        path = path & ChrW(92)
    End If
    AddPathSeparator = path
End Function

'---------------------------------------------------------------------------------------------------
'【処 理 名】ファイルコピー
'【処理概要】ファイルをコピーする。コピー先にディレクトリを指定した場合はそのディレクトリ下にコピー。
'            ファイルパスを指定した場合、そのファイル名でコピーされる。
'【引    数】[I]ByVal src As String           コピー元
'            [I]ByVal dst As String           コピー先(ディレクトリorファイルパス)
'            [I]ByVal overwrite As Boolean    上書き(True…上書き, False…上書きしない)
'【返 却 値】True  成功
'            False 失敗
'---------------------------------------------------------------------------------------------------
Public Function copyFile(ByVal src As String, ByVal dst As String, _
        ByVal overwrite As Boolean) As Boolean
    
    Dim oFso As New FileSystemObject
    
    copyFile = True
    On Error GoTo LBL_ERROR
    'コピー先がディレクトリの場合、末尾にセパレータを付加
    If Dir(dst, vbDirectory) <> "" Then
        dst = AddPathSeparator(dst)
    End If
    oFso.copyFile src, dst, overwrite

    GoTo LBL_TERMINAL
    
LBL_ERROR:
    copyFile = False
    MsgBox "コピーに失敗しました。"
    
LBL_TERMINAL:
    Set oFso = Nothing
End Function

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です