VBAツール：【Excel】前月データ一括バックアップツール
単純作業でも手作業だとミスも起きやすく、時間も取られてしまいます。
そこでVBAを使ったツールをExcelで作ってみました。
◆前月データ一括バックアップツール
Excelの見た目はこんな感じでシンプルです。
改良すれば先月だけでなく、前日分とか、前年分とか、応用がいろいろできるツールです。
【使い方】
(1)「バックアップ保存先フォルダ」の下の「A6」セルにフォルダのパスを貼り付けます。
(2)「バックアップ実行」ボタンを押します。
(3)ダイアログが開くので、バックアップしたいファイルの入っているフォルダを指定します。
(4)「完了」と出れば作成された前月フォルダにバックアップがコピーされます。
※ひとまず「xlsx」形式のみにしてあります。必要に応じて改良してください。
※ざっくりと作っただけで、エラー処理とかは入れていないので、使う際には処理を入れてください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 |
Option Explicit '************************************************************' Sub バックアップ() Dim FPath As String FPath = SelectFolderDialog Call main(FPath) MsgBox "完了" End Sub '************************************************************' Sub main(FPath As String) Dim bkFolderPath As String Dim bkPath As String Dim lastMonth As String Dim lastMDate As String '//バックアップフォルダの指定' bkFolderPath = Range("A6").Value lastMDate = DateAdd("m", -1, Now()) lastMonth = Year(lastMDate) & Format(Month(lastMDate), "00") bkPath = bkFolderPath & "\" & lastMonth '" '//フォルダの有無の確認。なければフォルダを作成する' If Dir(bkPath, vbDirectory) = "" Then MkDir bkPath End If '//バックアップ実行' Call call_folder_all_file_copy_paste(FPath & "\", bkPath & "\") End Sub '************************************************************' Public Function SelectFolderDialog() As String Dim myF As FileDialog Set myF = Application.FileDialog(msoFileDialogFolderPicker) With myF .InitialFileName = CreateObject("WScript.Shell").SpecialFolders("Desktop") '//最初に開く場所(初期フォルダ)の指定。ここではデスクトップにしています。' .Title = "バックアップをしたファイルの入ったフォルダの指定" '//ダイアログの左上に出てくるタイトル名' If .Show = True Then '//ダイアログを開く' SelectFolderDialog = .SelectedItems(1) '//指定したフォルダを返す' End If End With Set myF = Nothing End Function '************************************************************' '//指定したフォルダ内の指定した拡張子ファイルを全て、バックアップフォルダにコピペする' Sub call_folder_all_file_copy_paste(FPath As String, bkPath As String) Dim FName As String FName = Dir(FPath & "*.xlsx") '//拡張子xlsxのファイル全て。"*.xlsx"部分は必要なものに変更してください。' '//"*"(ワイルドカード)のみにすれば全てのファイルとフォルダになります。' '//取得したファイル全て完了までLoop' Do While FName <> "" FileCopy FPath & FName, bkPath & FName FName = Dir() Loop End Sub |
