ExcelVBAを使ってファイルの移動/コピーを自動化する
ファイルを整理するために毎回手作業でファイルを振り分けていませんか？
ExcelのVBAを使うとファイルを自動で該当のフォルダに振り分けることが可能になります。
今回はファイルを自動振り分けしたり、もとに戻したりできるサンプルアプリを紹介します。
ファイル整理業務の効率化につながるアプリとなっていますので活用ください。
フォルダをVBAで自動作成する方法については以下のリンク先をご覧ください。
https://scodebank.com/?p=949
サンプルアプリ実行動作
Excel上にある「ファイルの振り分け」ボタンをクリックするとファイルが該当フォルダに振り分けられます。
隣の「振り分けを戻す」ボタンをクリックすると元の位置にファイルが移動します。
サンプルコードの処理内容
今回のアプリはFSO（FileSystemObject）オブジェクトを利用してファイルを移動させています。
FSO（FileSystemObject）とはドライブ、フォルダ、ファイルを操作するためのオブジェクトです。
このオブジェクトの使い方は以下の通りとなります。
fsoというオブジェクトを入れる変数を定義
Dim fso As Object
fsoというオブジェクトにFileSystemObjectを代入
Set fso = CreateObject(“Scripting.FileSystemObject") ’ インスタンス化
移動元のファイル名と移動先を指定して「fso.MoveFile」メソッドを使って移動させます。
「PaFrom」が移動元のファイル、「PaTo & “\"」が移動先のフォルダのパスです。
fso.MoveFile PaFrom, PaTo & “\"
ファイルをコピーするには「fso.MoveFile」の代わりに「fso.Copyfile」を使います。
fso.Copyfile PaFrom, PaTo
& “\"
最後にfso変数をリセットします。
Set fso = Nothing
FSO（FileSystemObject）オブジェクトはファイルの移動、コピー機能の他さまざまなメソッド・プロパティが用意されています。詳細については下記リンンク先を参照ください。
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/filesystemobject-object
サンプルコード アプリの作成手順はこちら
Option Explicit
'ファイルを移動する
Sub Move_File1()
'コンピューターのファイル システムへアクセスするための準備
Dim fso As Object
' fsoというオブジェクトにFileSystemObjectを代入
Set fso = CreateObject("Scripting.FileSystemObject") ' インスタンス化
'読込み先ファイル名を取得
Dim myDir As String '当ファイルがあるフォルダパスを入れる変数を定義
Dim friwakeDir As String '当ファイルがあるフォルダパスを入れる変数を定義
Dim ReadFile As String '各読込み先ファイル
myDir = ThisWorkbook.Path '当ファイルがあるフォルダのパスをセット
friwakeDir = myDir & "\振り分けフォルダ" 'ファイルの移動を行うフォルダのパスをセット
Dim fl As Object '当ファイルがあるフォルダ名を入れるための変数を定義
Set fl = fso.GetFolder(friwakeDir) 'ファイルの移動を行うフォルダ名をセット
Dim fileName As String '特定の既存ファイル名を入れるための変数を定義
Dim f As Variant '個々の既存ファイル名を入れるための変数を定義（For Each 文で使用）
Dim PaFrom As String 'ファイルの移動元のパスを入れる変数をセット
Dim PaTo As String 'ファイルの移動先のパスを入れる変数をセット
Dim i As Integer
'カウンター変数の定義
i = 1
'fl.Filesプロパティから、そのフォルダの File オブジェクトの一覧を取得
For Each f In fl.Files ' フォルダ内のファイルを取得
'検索キーをセット
fileName = f.Name ' f.Nameプロパティから、そのファイルの拡張子付きの名前を取得
'移動元ファイルを変数「PaFrom」にセットする
PaFrom = friwakeDir & "\" & fileName
'ファイルの移動先フォルダをセットする
If Left(fileName, Len(fileName) - 4) = "札幌" Then
PaTo = friwakeDir & "\" & "1.札幌" & "\"
ElseIf Left(fileName, Len(fileName) - 4) = "仙台" Then
PaTo = friwakeDir & "\" & "2.仙台" & "\"
ElseIf Left(fileName, Len(fileName) - 4) = "東京" Then
PaTo = friwakeDir & "\" & "3.東京" & "\"
ElseIf Left(fileName, Len(fileName) - 4) = "名古屋" Then
PaTo = friwakeDir & "\" & "4.名古屋" & "\"
ElseIf Left(fileName, Len(fileName) - 4) = "大阪" Then
PaTo = friwakeDir & "\" & "5.大阪"& "\"
ElseIf Left(fileName, Len(fileName) - 4) = "福岡" Then
PaTo = friwakeDir & "\" & "6.福岡" & "\"
End If
'ファイルを移動先フォルダに移動
fso.MoveFile PaFrom, PaTo & "\" ' ファイル名を指定して移動
'ループ回数をカウントする
i = i + 1
Next
'fso変数をリセット
Set fso = Nothing
'処理完了メッセージを表示
MsgBox "ファイルの移動が完了しました。"
End Sub
'----------------------------------------------------------------------------
'ファイルを元の位置に戻す
Sub Move_File2()
'ファイルをWBS名のフォルダに移動
'コンピューターのファイル システムへアクセスするための準備
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject") ' インスタンス化
'読込み先ファイル名を取得
Dim myDir As String '当ファイルがあるフォルダパスを入れる変数を定義
Dim friwakeDir As String '当ファイルがあるフォルダパスを入れる変数を定義
Dim ReadFile As String '各読込み先ファイル
myDir = ThisWorkbook.Path '当ファイルがあるフォルダのパスをセット
friwakeDir = myDir & "\振り分けフォルダ"
Dim fl As Object '当ファイルがあるフォルダ名を入れるための変数を定義
Set fl = fso.GetFolder(friwakeDir) '当ファイルがあるフォルダ名をセット
Dim fileName As String '特定の既存ファイル名を入れるための変数を定義
Dim f As Variant '個々の既存ファイル名を入れるための変数を定義（For Each 文で使用）
Dim PaFrom As String 'ファイルの移動元のパスを入れる変数をセット
Dim PaTo As String 'ファイルの移動先のパスを入れる変数をセット
PaFrom = friwakeDir & "\"
PaTo = friwakeDir & "\" & "1.札幌" & "\" & "札幌.txt"
fso.MoveFile PaTo, PaFrom
PaFrom = friwakeDir & "\"
PaTo = friwakeDir & "\" & "2.仙台" & "\" & "仙台.txt"
fso.MoveFile PaTo, PaFrom
PaFrom = friwakeDir & "\"
PaTo = friwakeDir & "\" & "3.東京" & "\" & "東京.txt"
fso.MoveFile PaTo, PaFrom
PaFrom = friwakeDir & "\"
PaTo = friwakeDir & "\" & "4.名古屋" & "\" & "名古屋.txt"
fso.MoveFile PaTo, PaFrom
PaFrom = friwakeDir & "\"
PaTo = friwakeDir & "\" & "5.大阪" & "\" & "大阪.txt"
fso.MoveFile PaTo, PaFrom
PaFrom = friwakeDir & "\"
PaTo = friwakeDir & "\" & "6.福岡" & "\" & "福岡.txt"
fso.MoveFile PaTo, PaFrom
'fso変数をリセット
Set fso = Nothing
'処理完了メッセージを表示
MsgBox "ファイルの移動が完了しました。"
End Sub