Option Explicit

'(SHFileOperation)
Public Const FO_COPY = &H2                  'ファイルのコピー
Public Const FO_DELETE = &H3                'ファイルの削除
Public Const FO_MOVE = &H1                  'ファイルの移動
Public Const FO_RENAME = &H4                'ファイル名の変更

Public Const FOF_ALLOWUNDO = &H40           'ゴミ箱へ
Public Const FOF_CONFIRMMOUSE = &H2         '使えない
Public Const FOF_FILESONLY = &H80           'ディレクトリを含まない
Public Const FOF_MULTIDESTFILES = &H1       '
Public Const FOF_NOCONFIRMATION = &H10      '確認なし
Public Const FOF_NOCONFIRMMKDIR = &H200     'ディレクトリ作成時に確認なし
Public Const FOF_RENAMEONCOLLISION = &H8    '
Public Const FOF_SILENT = &H4               '確認なし。プログレスバーあり
Public Const FOF_SIMPLEPROGRESS = &H100     'ファイル名なし
Public Const FOF_WANTMAPPINGHANDLE = &H20   '

Type SHFILEOPSTRUCT
  hWnd As Long                     'ウィンドウのハンドル
  wFunc As Long                    '操作方法(FO_xxx)
  pFrom As String                  '操作元のファイル名・ディレクトリ名
                                   '複数の場合は Chr(0)で区切る
                                   '最後は二つのChr(0)で終わる
  pTo As String                    '操作先のファイル名・ディレクトリ名
  fFlags As Integer                '操作フラグ(FOF_xxx)
  fAnyOperationsAborted As Long    '処理完了前にｷｬﾝｾﾙしたとき 1
  hNameMappings As Long            'ファイルネームマッピングオブジェクトのハンドル(0 でもよい)
  lpszProgressTitle As String      'ダイアログボックスのキャプション(ブランク可)
End Type

Declare Function SHFileOperation Lib "SHELL32" (lpFileOp As SHFILEOPSTRUCT) As Long

Function LsFileCopy(source As String, destination As String, Optional fFlags As Integer = FOF_NOCONFIRMATION) As Long
    'ファイルまたはフォルダをコピー
    '(FileCopy ステートメントの拡張版)
    '   source      : コピー元ファイルまたはフォルダ（サブフォルダごとコピーできます）
    '   destination : コピー先ファイルまたはフォルダ（フォルダがなければ作ってくれます）
    '   fFlags      : FOF_xxxを指定(+で複数指定できます)
    '   成功=0
    Dim rc As Long
    Dim lpFileOp As SHFILEOPSTRUCT
    
    With lpFileOp
        .hWnd = 0
        .wFunc = FO_COPY
        .pFrom = source
        .pTo = destination
        .fFlags = fFlags
        .fAnyOperationsAborted = 0
        .hNameMappings = 0
        .lpszProgressTitle = vbNullString
    End With
    
    rc = SHFileOperation(lpFileOp)
    LsFileCopy = rc
End Function

Function LsKill(source As String, Optional fFlags As Integer = FOF_NOCONFIRMATION) As Long
    'ファイルまたはフォルダを削除(ゴミ箱へ移すこともできます)
    '(Kill ステートメントの拡張版)
    '   source      : コピー元ファイルまたはフォルダ（サブフォルダごと削除できます）
    '   fFlags      : FOF_xxxを指定(+で複数指定できます)
    '   成功=0
    Dim rc As Long
    Dim lpFileOp As SHFILEOPSTRUCT
    
    With lpFileOp
        .hWnd = 0
        .wFunc = FO_DELETE
        .pFrom = source
        .pTo = vbNullString
        .fFlags = fFlags
        .fAnyOperationsAborted = 0
        .hNameMappings = 0
        .lpszProgressTitle = vbNullString
    End With
    
    rc = SHFileOperation(lpFileOp)
    LsKill = rc
End Function

Function LsName(source As String, destination As String, Optional fFlags As Integer = FOF_NOCONFIRMATION) As Long
    'ファイルまたはフォルダの名前変更
    '(Name ステートメント相当)
    '   source      : 名前変更前ファイルまたはフォルダ
    '   destination : 名前変更前ファイルまたはフォルダ
    '   fFlags      : FOF_xxxを指定(+で複数指定できます)
    '   成功=0
    Dim rc As Long
    Dim lpFileOp As SHFILEOPSTRUCT
    
    With lpFileOp
        .hWnd = 0
        .wFunc = FO_RENAME
        .pFrom = source
        .pTo = destination
        .fFlags = fFlags
        .fAnyOperationsAborted = 0
        .hNameMappings = 0
        .lpszProgressTitle = vbNullString
    End With
    
    rc = SHFileOperation(lpFileOp)
    LsName = rc
End Function

Function LsMove(source As String, destination As String, Optional fFlags As Integer = FOF_NOCONFIRMATION) As Long
    'ファイルまたはフォルダを移動
    '(FileCopy ステートメントの拡張版)
    '   source      : 移動元ファイルまたはフォルダ（サブフォルダごと移動できます）
    '   destination : 移動先ファイルまたはフォルダ（フォルダがなければ作ってくれます）
    '                 異なるドライブへの移動はできません。
    '   fFlags      : FOF_xxxを指定(+で複数指定できます)
    '   成功=0
    Dim rc As Long
    Dim lpFileOp As SHFILEOPSTRUCT
    
    With lpFileOp
        .hWnd = 0
        .wFunc = FO_MOVE
        .pFrom = source
        .pTo = destination
        .fFlags = fFlags
        .fAnyOperationsAborted = 0
        .hNameMappings = 0
        .lpszProgressTitle = vbNullString
    End With
    
    rc = SHFileOperation(lpFileOp)
    LsMove = rc
End Function