VBA講座

今開いているファイルから、このプログラムを実行すると、Eドライブの営業所2フォルダに第一営業部.xlsm
ファイルができるが、その時に今開いているファイルは閉じられて、第一営業部.xlsmが開かれた状態になる。

FN=ActiveWorkbook .Name　　　　　　　　　　　' 名前を取得している。
AP=ActiveWorkbook.Path　　　　　　　　　　　　' アドレスを取得している。
Workbooks .Open Filename : = AP & "\" & FN　　' 名前とアドレスで開いている。

3.フォルダの削除

Sub 指定フォルダを参照する()
　　Dim OpenFolder As String

　　On Error Goto ERR　　　　　　　　　　　' Eドライブに営業所2が無かったらエラーになるので、
　　　　　　　　　　　　　　　　　　　　　　' エラーを発生させないで、終了させるためにジャンプ
　　　　　　　　　　　　　　　　　　　　　　' させる。
　　OpenFolder="E:\ "
　　Shell "C:\Windows\explorer.exe " & OpenFolder, vbNormaiFocus
　　　　　　　　　　　　　　　　　　　　　　' 文法はこのまま使用する。
　　　　　　　　　　　　　　　　　　　　　　' 注意点は、explorer.exe "　の部分は、"の前に半角スペースが
　　　　　　　　　　　　　　　　　　　　　　' 必要です。
　　Exit Sub
ERR:
　　MsgBox "フォルダ無し"　　　　　　　　　' フォルダが無い場合は、メッセージが出る。
End sub

Sub フォルダ内のファイル名列挙( )
　　Range("B1:B10") .ClearContents　　　　　　' 書き出し範囲のデータを消去
　　FP="E:営業所2"
　　FN=Dir(FP & "\*.*")　　　　　　　　　　　　' すべてのファイル名 . すべての拡張子
　　Worksheets("Sheet1") .Activate
　　貼付行=1　　　　　　　　　　　　　　　　　' B列の1行目から書き出す。
　　Do While FN<>""　　　　　　　　　　　　　 ' 営業所2フォルダ内を上から順に見て行き、空白で
　　　　　　　　　　　　　　　　　　　　　　　　' 無かったら実行する。
　　　　　　　　　　　　　　　　　　　　　　　　' Do から Loop の間をファイル名が無くなるまで
　　　　　　　　　　　　　　　　　　　　　　　　' 繰り返す。
　　　　Range("B" & 貼付行) .Value=FN　　　　 ' B1にFNを書く。
　　　　貼付行=貼付行+1　　　　　　　　　　　　' 貼付行に1を加算する。下記位置を一行下へ移動する。
　　　　FN=Dir()　　　　　　　　　　　　　　　　' ファイル名を空にしている。
　　Loop
End Sub

5. 指定フォルダを開く