【VBA】フォルダとファイルを確認して作成する | ITスキルを伸ばすサイト／WEBサイトやプログラムのあれこれ【HTML、CSS、Javascript、PHP、VBA、python】

VBAでテキストやログを出力することもあります。

そんなときの一連の流れを書いていきます。

概要
参照設定
フロー
ソース

概要

テキストファイルを出力する前提で、その日のフォルダを作成して各ファイルを作成するというVBAです。

csv出力やxml出力、log出力などにも使えます。

出力するファイルの内容は一括で変数化しておく前提です。

参照設定

今回はFileSystemObjectを使うので参照設定をしましょう。

VBEからツール⇒参照設定⇒「Microsoft Scripting Runtime」にチェックを入れましょう。

フロー

フローとしては

①ファイルを出力するフォルダがあるか
①－１なければフォルダを作成
②出力するファイスがすでに存在しないかを確認
②－１なければファイルを作成
②ー２あれば出力しない
③内容を記載して保存

となります。

ソース

Sub txt_output()
	'本日フォルダ確認
	Dim fso_dir As FileSystemObject
	Set fso_dir = CreateObject("Scripting.FileSystemObject") ' インスタンス化
	HT_crntdir = ThisWorkbook.Path 'カレントディレクトリパス
	HT_today_dir = HT_crntdir & "\" & Format(Now(), "yyyymmdd") 'パス付本日日付のディレクトリ名
	HT_file_name = Format(Now(), "yyyymmdd") & ".txt"
	put_text = "テキストの内容はここ"
	 
	'存在確認をして無ければ作成
	If Dir(HT_today_dir, vbDirectory) = "" Then
		Set fl_main = fso_dir.CreateFolder(HT_today_dir) ' フォルダ作成
		If IsEmpty(fl_main) Then 'エラー確認
		MsgBox "フォルダが作成できませんでした。格納場所を変えて作成してください。"
		GoTo err100
		End If
	End If
	'本日ファイル確認
	Dim HT_file As Variant
	HT_file = Dir(HT_today_dir & "\" & HT_file_name)
	If HT_file &lt;&gt; "" Then 'ファイルがあれば終了
		MsgBox "ファイルがすでに有ります。格納場所を変えて作成してください。"
		GoTo err100
	End If
	 
	'ファイル出力
	Dim outObj As Object
	Dim fso As FileSystemObject
	Set fso = New FileSystemObject ' インスタンス化
	Set ts = fso.CreateTextFile(HT_today_dir & "\" & HT_file_name, Overwrite:=True, Unicode:=False)
	ts.Close ' ファイルを閉じる
	'ファイル内容書き込み
	Set outObj = CreateObject("ADODB.Stream")
	outObj.Type = 2 ' 1: バイナリデータ, 2:テキストデータ
	outObj.Charset = "euc-jp" '文字コード
	outObj.LineSeparator = 10 ' -1⇒CRLF, 10⇒LF, 13⇒CR
	outObj.Open
	outObj.WriteText put_text, 0 'テキスト
	outObj.SaveToFile HT_today_dir & "\" & HT_file_name, 2 '上書き保存
	outObj.Close
	Set outObj = Nothing
	 
	err100:
End Sub