#112
AccessのVBAには、ファイルをコピーする手段として「FileCopyステートメント」が用意されています。しかし、WindowsAPIを使うと、エクスプローラでファイルのコピーを実行したときと同じように、紙がフォルダからフォルダへとヒラヒラ飛んでいく、あのダイアログを表示させながらファイルのコピーを実行させることができます。
それには"SHELL32.DLL"にあるWindowsAPIの「SHFileOperation」関数を使用します。
まず標準モジュールに次のコードを記述します。"Type"および"Declare"の前に、"Private"を付けることによってフォームのモジュールにも記述できます。
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Declare Function SHFileOperation Lib "SHELL32.DLL" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Const FO_COPY = &H2
Const FO_MOVE = &H1
Const FOF_NOCONFIRMATION = &H10
Const FOF_RENAMEONCOLLISION = &H8
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Declare Function SHFileOperation Lib "SHELL32.DLL" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Const FO_COPY = &H2
Const FO_MOVE = &H1
Const FOF_NOCONFIRMATION = &H10
Const FOF_RENAMEONCOLLISION = &H8
次の例では、ファイル"c:\My Documents\Test.mdb"を"c:\Test.mdb"にコピーします。
Dim stShellOp As SHFILEOPSTRUCT
Const cstrSrcFile As String = "c:\My Documents\Test.mdb"
Const cstrDstFile As String = "c:\Test.mdb"
With stShellOp
'Accessのハンドルをセット
.hwnd = Application.hWndAccessApp
'コピーモードを指定
.wFunc = FO_COPY '移動時は FO_MOVE
'コピー元ファイルのフルパスをセット
.pFrom = cstrSrcFile
'コピー先ファイルのフルパスをセット
.pTo = cstrDstFile
'.fFlags = FOF_NOCONFIRMATION
'.fFlags = FOF_RENAMEONCOLLISION
End With
'コピーを実行
If SHFileOperation(stShellOp) = 0 Then
Beep
MsgBox "コピー完了しました！"
Else
Beep
MsgBox "コピーに失敗またはキャンセルされました！"
End If
Const cstrSrcFile As String = "c:\My Documents\Test.mdb"
Const cstrDstFile As String = "c:\Test.mdb"
With stShellOp
'Accessのハンドルをセット
.hwnd = Application.hWndAccessApp
'コピーモードを指定
.wFunc = FO_COPY '移動時は FO_MOVE
'コピー元ファイルのフルパスをセット
.pFrom = cstrSrcFile
'コピー先ファイルのフルパスをセット
.pTo = cstrDstFile
'.fFlags = FOF_NOCONFIRMATION
'.fFlags = FOF_RENAMEONCOLLISION
End With
'コピーを実行
If SHFileOperation(stShellOp) = 0 Then
Beep
MsgBox "コピー完了しました！"
Else
Beep
MsgBox "コピーに失敗またはキャンセルされました！"
End If
上記のコードを実行したとき、同名のファイルがすでに存在する場合も、もちろんエクスプローラと同様に上書き確認のダイアログが表示されます。
- コピー先のフォルダが存在しない場合、新規作成するかどうかの確認ダイアログが表示されます。
- With stShellOp 〜 End With の間に次の１行を追加すると、同名のファイルがすでに存在する場合に上書き確認のダイアログを表示せず、強制的に上書きコピーします。
.fFlags = FOF_NOCONFIRMATION - With stShellOp 〜 End With の間に次の１行を追加すると、同名のファイルがすでに存在する場合に上書き確認のダイアログを表示せず、「コピー 〜 Test.mdb」というような名前のファイルとしてコピーします。
.fFlags = FOF_RENAMEONCOLLISION - "FO_COPY"の替りに、wFuncに"FO_MOVE"を指定すると「ファイルの移動」になります。
