あるフォルダにある全ExcelファイルをA列のセルに入れるプロシージャを作る。以下を、標準モジュールに書く。
Sub dir2Cell()
Dim r As Range
Set r = Range("a1") '選択しているシートのA1セルをr変数にSet
r.Value = VBA.Dir("*.xl*") 'カレントフォルダのエクセルファイル
Dim i As Integer
Do Until "" = r.Offset(i, 0) 'iは0から始まる
i = i + 1
r.Offset(i, 0) = VBA.Dir 'Dirの繰り返し
Loop
End Sub
Sub dir2cell range(“a1”)からEnd Subの間にマウスでクリック、カーソルを置いてから実行ボタン▶を押して実行する。今、選択しているワークシートのセルA1から下にエクセルのファイル名が入る。
セルA列のファイルをセルB列の名前で保存するプロシージャを作る。B列に変更するファイル名を入れる。次図のようにB列に入れると、1.xls->a.xls,2.xlsx->b.xlsにコピーする。
プログラムでは、A1のセルから下向きに何も入ってないセルまで実行する。
プログラムの実行時に、セルA1を選択(ActveCell)にして、bookCopyのプロシージャ内にマウスを置いて実行ボタン▶を押す。
'コピーを開始するファイル名があるセルを先に選択しておく
Sub bookCopy()
Dim r As Range, i As Integer
Set r = Excel.ActiveCell '選択しているセルのオブジェクトをr変数にセットする
Do
VBA.FileCopy r.Offset(i, 0), r.Offset(i, 1)
i = i + 1
Loop Until "" = r.Offset(i, 0)'何も入ってないともうファイルは無いので終える
End Sub
次図は、エクスプローラーで結果確認。
もし、Excelで開いているファイルをFileCopyしようとするとエラーで止まる。
移動の処理にする場合は、元のファイルを削除すればいい。Killコマンドで削除する。ファイル名を変数に入れて、その都度その変数名でKillすればいい。
'削除をするファイル名があるセルの列の一番上を選択しておく
Sub delA1()
Dim r As Range, i As Integer
Set r = Excel.ActiveCell '選択しているセルのオブジェクトをr変数にセットする
Do
Debug.Print "削除するファイル名:" & r.Offset(i, 0)
Stop '実行ボタンを押すとかF8で次に進む
VBA.Kill r.Offset(i, 0) '削除
i = i + 1
Loop Until "" = r.Offset(i, 0) '何も入ってないともうファイルは無い
End Sub
1.xlsと2.xlsxの2つのファイルが消えます。Sub delA1からEnd Subの間にカーソルを移動してから実行ボタン▶かF8(ステップ実行)を押すと「削除するファイル名:1.xls」がイミディエイトウィンドウに出力されてStopステートメントで中断中になる。この時点で1.xls ファイルが無くなっている。さらに実行ボタン▶かF8を押す と「 削除するファイル名:2.xlsx」がイミディエイトウィンドウに出力されて中断中になる。
(Visited 298 times, 1 visits today)