● FileCopy Source, Destination
コピー元 コピー先
●『使用例』 FileCopy ”C:\DATA\Sample.xlsx”,”C:\DATA\Bk_Sample.xlsx”,
これから説明しますサンプルプログラム④・⑤は、「FileSystemObject」を使いファイル名やフルパス情報など取得する際に利用していますので、必ず下記のFileSystemObjectの設定方法(参照設定)を行って下さい。
●【FileSystemObject】とは、さまざまなファイルやフォルダー情報を調べたり、ファイルやフォルダーをVBAプログラムで操作する時に、FileSystemObjectを利用して簡単に情報取得や操作を行う事が出来ます。これから説明するプログラムにも利用していますので、必ず下記の通りに設定して下さい。
●FileSystemObjectを利用するための参照設定
【設定方法】
①VBE(Visual Basic Editor)から【ツール】を選択する
②【参照設定】をクリックする
③【参照設定ーVBAProject】の中から「Microsoft Scripting Runtime」にチェックする
④【OK】ボタンをクリックして設定します。
下記のサンプルプログラムは、指定したファイルをコピーします。
●ファイルのコピー元 : C:\DATA¥Master1.xlsx
●ファイルのコピー先 : C:¥DATA¥BK_Master1.xlsx (新規作成)
★ファイルのコピー先が、既に作成されている場合は、上書き保存されます。
'
'******** AKIRA55.COM ******* https://akira55.com/filecopy/ '
'
Sub FileCopy01() '指定したファイルをコピーする。
Dim MotoCopy, SakiCopy As String
MotoCopy = "C:\DATA\Master1.xlsx" 'ファイルのコピー元
SakiCopy = "C:\DATA\BK_Master1.xlsx" 'ファイルのコピー先(新規作成)
filecopy MotoCopy, SakiCopy 'ファイルのコピー
End Sub
'
下記のサンプルプログラムは、指定したファイルをコピーしますが、コピー先にフォルダーを作成してファイルをコピーします。ただし、既に、フォルダーが作成されている場合は、フォルダーは、作成しません。
●ファイルのコピー元 : C:\DATA¥Master1.xlsx
●ファイルのコピー先 : C:¥DATA¥BACKUP\BK_Master1.xlsx
バックアップアップ先のフォルダー「BACKUP」を作成します。(新規作成)
'
'******** AKIRA55.COM ******* https://akira55.com/filecopy/
'
Sub FileCopy02() '指定するファイルをコピーする際に、フォルダーを作成してコピーする。
Dim MotoCopy, SakiCopy As String
MotoCopy = "C:\DATA\Master1.xlsx" 'ファイルのコピー元
SakiCopy = "C:\DATA\BACKUP\BK_Master1.xlsx" 'ファイルのコピー先(新規作成)
If Dir("C:\DATA\BACKUP", vbDirectory) = "" Then
MkDir "C:\DATA\BACKUP" 'BACKUP用フォルダーを作成します。
End If
filecopy MotoCopy, SakiCopy 'ファイルのコピー
End Sub
'
下記のサンプルプログラムは、サンプル②の応用になります。サンプル②同様に指定したファイルをコピーするプログラムになりますが、その際に【BACKUP】フォルダーを確認してフォルダダーが無ければ作成し、更にコピー先にファイルが作成されていれば、上書きを行うか確認するサンプルプログラムです。
【下記のプログラムを実行する場合】●FileSystemObjectの設定方法(参照設定:上記)を設定して下さい。
【処理条件①】フォルダーを確認します【BACKUP:フォルダー】
●ファイルのコピー元 : C:\DATA¥Master1.xlsx
●ファイルのコピー先 : C:¥DATA¥BACKUP\BK_Master1.xlsx
バックアップアップ先のフォルダー「BACKUP」を作成します。(新規作成)
【処理条件②】ファイルを確認します。【BK_Master1.xlsx:ファイル 】
●ファイルのコピー元 : C:\DATA¥Master1.xlsx
●ファイルのコピー先 : C:¥DATA¥BACKUP\BK_Master1.xlsx
バックアップアップ先のフォルダー「BACKUP」を作成します。(新規作成)
'
'******** AKIRA55.COM ******* https://akira55.com/filecopy/
'
Sub FileCopy03() '指定するファイルをコピーする際に、上書き確認する
Dim MotoCopy, SakiCopy As String
Dim Rc As Integer
MotoCopy = "C:\DATA\Master1.xlsx" 'ファイルのコピー元
SakiCopy = "C:\DATA\BACKUP\BK_Master1.xlsx" 'ファイルのコピー先(新規作成)
If Dir("C:\DATA\BACKUP", vbDirectory) = "" Then 'BACKUP用フォルダーがあるか?
MkDir "C:\DATA\BACKUP" 'BACKUP用フォルダーを作成します。
End If
If Dir(SakiCopy) <> "" Then
Rc = MsgBox("上書きしますか?", vbYesNo + vbQuestion, "確認")
If Rc = vbNo Then
MsgBox "ファイルコピーの上書き処理を中断します。"
Exit Sub
End If
End If
filecopy MotoCopy, SakiCopy 'ファイルのコピーを実施
End Sub
'
下記のサンプルプログラムは、複数ファイルを選択いてコピーするサンプルプログラムです。まず、ダイアログボックスが表示されて、コピーしたいファイルを選択します。コピー先に、バックアップ用フォルダーを作成して、そこに選択したファイルをコピー(バックアップ)します。ファイルを一つずつ選択してコピーが行えるので、必要なファイルのみ選択してコピー(バックアップ)する事が出来ます。
【下記のプログラムを実行する場合】●FileSystemObjectの設定方法(参照設定:上記)を設定して下さい。
【処理手順①】
●ダイアログボックスが表示されて、コピーするファイルを選択します。
【処理手順②】
●選択したファイルのフォルダー内に「BACKUP」フォルダーを作成します。
・フォルダー内に「BACKUP」フォルダーが無い場合は新規にフォルダーを作成します。
・フォルダー内に「BACKUP」フォルダーが有る場合は、そのまま何もしません。
【処理手順③】
●選択したファイルが「BACKUP」フォルダーにコピー(バックアップ)されます。
※(既に同じファイル名のファイルが有る場合は、上書きされます。)
'
'******** AKIRA55.COM ******* https://akira55.com/filecopy/
'
Sub FileCopy04() '複数選択したファイルをバックアップフォルダーにファイルコピーする。
Dim File_function As New Scripting.FileSystemObject
Dim SetFile As Scripting.File
Dim I, F As Long
Dim FolderName, MotoCopy, SakiCopy As String
Dim FileName As Variant
FileName = Application.GetOpenFilename(MultiSelect:=True)
'ダイアログボックスが表示(MultiSelect:=Trueでファイルを複数選択)
On Error GoTo err_shori
If UBound(FileName) > 0 Then
FolderName = File_function.GetParentFolderName(FileName(1))
'選択した最初のファイル名からフォルダーまでのルートを取得する
End If
If Dir(FolderName & "\BACKUP", vbDirectory) = "" Then '選択したフォルダーにバックアップフォルダーな無ければ、フォルダーを作成します。
MkDir FolderName & "\BACKUP" 'BACKUP用フォルダーを作成します。
End If
F = 1 '選択したファイル目の1件目を指定
For I = 2 To 1 + UBound(FileName) '選択したファイルの数を繰り返す。(最大値)
Set SetFile = File_function.GetFile(FileName(F)) 'ファイルをFileオフジェクトとして登録
MotoCopy = SetFile.Path 'バックアップ元のファイルパス
SakiCopy = FolderName & "\BACKUP\" & "BK_" & SetFile.Name 'バックアップ先のファイルパスとファイル名に”BK_”を先頭に付ける
filecopy MotoCopy, SakiCopy 'ファイルのコピーを実施
F = F + 1
Next I
MsgBox UBound(FileName) & "個のファイルがコピーされました。"
Exit Sub
err_shori: 'ダイアログボックスをそのまま閉じる。ファイルを選択しないでキャンセルした場合は、この場所に飛びます。
MsgBox "キャンセルされました。"
End Sub
'
下記のサンプルプログラムは、フォルダーを選択してフォルダー内の全てのファイルをコピー先のBACKUPフォルダーへコピーするサンプルプログラムです。まず、ダイアログボックスが表示されて、丸ごとファイルをコピーしたいフォルダーを選択します。コピー先に、バックアップ用フォルダーを作成して、そこに選択したフォルダーごとファイルがコピー(バックアップ)されます。フォルダー内に大量のファイルが有る場合に、一気にコピー(バックアップ)する事が出来ます。
【下記のプログラムを実行する場合】●FileSystemObjectの設定方法(参照設定:上記)を設定して下さい。
【処理手順①】
●ダイアログボックスが表示されて、コピーするフォルダー内を選択します。
※(フォルダー内のファイルは、全てコピーされます。)
【処理手順②】
●選択したフォルダー内に「BACKUP」フォルダーを新規作成します。
・フォルダー内に「BACKUP」フォルダーが無い場合は新規にフォルダーを作成します。
・フォルダー内に「BACKUP」フォルダーが有る場合は、そのまま何もしません。
【処理手順③】
●選択したフォルダー内のファイルが全て「BUAKUP」フォルダーにコピー(バックアップ)されます。
※(既に同じファイル名のファイルが有る場合は、上書きされます。)
'
'******** AKIRA55.COM ******* https://akira55.com/filecopy/
'
Sub FileCopy05() '複数選択したフォルダーをバックアップフォルダーに全ファイルコピーする。
Dim File_function As New Scripting.FileSystemObject
Dim SetFile As Scripting.File
Dim F As Object
Dim FolderName, FolderRoot, MotoCopy, SakiCopy As String
Dim FileName As Variant
With Application.FileDialog(msoFileDialogFolderPicker) 'ダイアログボックスを表示してフォルダーを選択します。
If .Show = 0 Then Exit Sub 'プログラムを終了 (フォルダーが選択されていない。もしくはキャンセル)
Set FolderName = File_function.GetFolder(.SelectedItems(1)) '選択したフォルダー名をセットします。
End With
If Dir(FolderName & "\BACKUP", vbDirectory) = "" Then '選択したフォルダーにバックアップフォルダーな無ければ、フォルダーを作成します。
MkDir FolderName & "\BACKUP" 'BACKUP用フォルダーを作成します。
End If
For Each F In File_function.GetFolder(FolderName).Files 'フォルダー内の全てのファイルを順番に繰り返します。
Set SetFile = File_function.GetFile(F) 'フォルダー内のファイルをひとつずつセットします。
MotoCopy = SetFile.Path 'バックアップ元のファイルパス
SakiCopy = FolderName & "\BACKUP\" & "BK_" & SetFile.Name 'バックアップ先のファイルパスとファイル名に”BK_”を先頭に付ける
filecopy MotoCopy, SakiCopy 'ファイルのコピーを実施
Next F '全てのファイルが終了まで繰り返します。
MsgBox "ファイルのコピーが終了しました。"
End Sub
'