ExcelのVBAで開かれている(ロックされている)ファイルをコピーするサンプルプログラムを覚書。
例えば今開いている編集中のファイルなどをファイルを閉じずに別の場所にコピーしたい場合のVBAのサンプルプログラム。
ExcelのVBAでファイルをコピーする処理を実行する場合、"FileCopy"を使用しますが、コピー元が開かれている場合、"FileCopy"では「実行時エラー '70': 書込みできません。」というエラーメッセージが表示され、コピーが出来ません。
そういった場合でもコピーをできるようにするExcel VBAのサンプルプログラムを紹介します。
Excel VBAの"FileCopy"について
ExcelのVBAでファイルをコピーする際に使用する"FileCopy"は開かれているファイルをコピーすることはできません。
例えば、コピー元のファイルが開かれている状態で以下のようなプログラムを実行するとエラーメッセージが表示されてコードの実行が中止されます。
Sub Sample01()
FileCopy ThisWorkbook.FullName, "c:¥temp¥test.xlsm"
End Sub
実行時に表示されるエラーメッセージ。
開かれているファイルでもコピーすることができるVBAのサンプルプログラム
コピー元ファイルが閉じている(使用されていない)ことを保証できない場合は、ExcelのVBAの"FileCopy"を使用せずに"Scripting.FileSystemObject"の"CopyFile" を使用します。
以下がそのサンプルプログラムです。
Sub Sample02()
Dim objFSO As Object, txtSource As String, txtDestination
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile ThisWorkbook.FullName, "c:¥temp¥test.xlsm"
End Sub
"Scripting.FileSystemObject"の"CopyFile" を使用すれば開かれているファイルでもコピーが可能です。
ちなみに上記サンプルプログラムでは、コピー先に同一名のファイルが有った場合は無条件に上書き保存されます。
コピー先に同一名のファイルが存在した場合の処理を追加したサンプルプログラム
ちょっとサンプルプログラムを変更して、コピー先に同一名のファイルが有った場合には上書き保存するかどうかユーザーに問い合わせるメッセージを表示させ、ユーザーの選択によって上書き保存するか処理を中止するかを判断して処理するようにしたサンプルプログラムです。
Sub Sample02()
Dim objFSO As Object, txtSource As String, txtDestination
Dim intAns As Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo ErrHandler
objFSO.CopyFile ThisWorkbook.FullName, "c:¥temp¥test.xls", False
Exit Sub
ErrHandler:
If Err.Number = 58 Then
intAns = MsgBox("コピー先に同一名のファイルが存在します。" & vbCrLf & "上書き保存しますか?", vbYesNo + vbQuestion)
If intAns = vbYes Then
objFSO.CopyFile ThisWorkbook.FullName, "c:¥temp¥test.xls", True
End If
End If
End Sub
ExcelのVBAで開かれているファイルをコピーするサンプルプログラムまとめ
ExcelのVBAを使って開かれているファイルをコピーするサンプルプログラムを紹介しました。
サンプルプログラムでは触れていませんが、ファイルのコピーする際には色々考慮が必要です。
コピー元ファイルの存在チェック、コピー先に同一名のファイル名のファイルの有無チェック、コピー先に同一名のファイルが存在し、かつそのファイルが開かれているかどうかなど、想定できるケースについてそれぞれ必要な処理を用意する必要があります。
コメント
ありがとうございます。使わせていただきました。悩んでいたので、助かります。
カマタヒロミツさん
コメントありがとうございます。役に立ってよかったです!
Excellent article. I will be experiencing some of these issues as
well..