EXCEL VBA クラス ファイルの入出力を変数のように容易に行う。

ファイルの入出力を変数のように容易に行うクラス。

イメージ

クラスの取り込み方は、
pgbigoroku.hatenablog.com
を参照してください。

サンプル。ファイル名を指定して、ファイルへ書き込み、読み込みを行う。

Public Sub sample()
    Dim cTxtFile As New clsTxtFile
    cTxtFile.ファイル名フルパス = "C:\a.txt"    'ファイル名を指定
    cTxtFile.情報 = "aaa"   'ファイルに書き込み
    Debug.Print cTxtFile.情報  'ファイルから読み込み、イミディエイト画面に出力
End Sub

ソースコード

'オブジェクト名は「clsTxtFile」にしてください。
'
'   クラス機能　　　:  ファイルの入出力を変数のように容易に行う。
'
'
'プロパティ
'   ファイル名フルパス  読み書きするファイルのフルパス（デフォルトとしてActiveworkbook.Pathの値をinitで入れる）
'　　情報　　　　　　　　ファイルへの読み書き
'関数
'　　情報挿入　　　　　　ファイルへの書き込み（プロパティ「情報」との違いは、エラー時にFalseを戻す）
'
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/17/142503
'2022/8/17

Option Explicit

Public ファイル名フルパス As String

'初期化
'  デフォルトで新しいファイル名を採番する。
Private Sub Class_Initialize()
    ファイル名フルパス = nstr利用していないファイル名を取得(ActiveWorkbook.Path, ".txt")
End Sub

Public Function 指定フォルダにユニークなファイルを作成する(ByVal pstrこのフォルダ名配下に作る As String, ByRef pstr拡張子 As String) As Boolean
    Dim str利用していないファイル名を取得 As String
    str利用していないファイル名を取得 = nstr利用していないファイル名を取得(pstrこのフォルダ名配下に作る, pstr拡張子)
    If str利用していないファイル名を取得 = "" Then
        指定フォルダにユニークなファイルを作成する = False
    Else
        ファイル名フルパス = str利用していないファイル名を取得
        指定フォルダにユニークなファイルを作成する = True
    End If
End Function


'値入力用
'プロパティと異なるのは、代入不可能の場合に戻り値FALSEとする。
Public Function 情報挿入(ByVal データ As String) As Boolean
    On Error GoTo Err_情報挿入
    Dim intFreeFile As Integer
    intFreeFile = FreeFile
    Open ファイル名フルパス For Output As #intFreeFile
        Print #intFreeFile, データ;
    Close #intFreeFile
    情報挿入 = True
Exit Function
Err_情報挿入:
    情報挿入 = False
    Exit Function
    Resume Next
End Function

Property Let 情報(ByVal データ As String)
    Call 情報挿入(データ)
End Property

Property Get 情報() As String
    Dim intFreeFile As Integer
    Dim strRet As String
    Dim strOneLine As String
    On Error GoTo err情報
    If nblnファイル存在確認(ファイル名フルパス) = True Then
        intFreeFile = FreeFile
        Open ファイル名フルパス For Input As #intFreeFile
            Do While Not EOF(intFreeFile)
                Line Input #intFreeFile, strOneLine
                strRet = strRet & vbCr & strOneLine
            Loop
        Close #intFreeFile
        If Len(strRet) = 0 Then
            情報 = ""
        Else
            情報 = Mid(strRet, 2)
        End If
    Else
        情報 = ""
    End If
Exit Property
err情報:
    情報 = ""
    Exit Function
    Resume Next
End Property


'
'   機能　　　:  利用していないファイル名を取得
'
'    返り値　　:     存在していないファイル名（フルパス）
'
'    引き数　　:    ByVal pstrこのフォルダ名配下に作る As String 使用していないファイルを作るフォルダ
'                   ByRef pstr拡張子 As String　　　　　　　　　　新しく作るファイルの拡張子（.があっても無くてもOK）
'    機能説明　:     ワイルドカードは使えません
'
'
'    備考　　　:     -
'
'    この関数のURL　　：https://pgbigoroku.hatenablog.com/entry/2022/08/17/094450
'
'    この関数を利用するために必要な関数：https://pgbigoroku.hatenablog.com/entry/2022/08/17/005434
'
'    バージョン　　：2022/8/16
'
Private Function nstr利用していないファイル名を取得(ByVal pstrこのフォルダ名配下に作る As String, ByRef pstr拡張子 As String) As String
    Dim intFor As Integer
    Dim strDate As String
    Dim strtempFilename As String
    Dim str拡張子 As String
    If Left(pstr拡張子, 1) = "." Then
        pstr拡張子 = pstr拡張子
    Else
        pstr拡張子 = "." & pstr拡張子
    End If
    strDate = Format(Now, "yyyy_mm_dd_hh_mm_ss_")
    For intFor = 1 To 9999
        strtempFilename = nstrフルパスにする(pstrこのフォルダ名配下に作る, strDate & CStr(intFor) & pstr拡張子)
        If nblnファイル存在確認(strtempFilename) = True Then
        Else
            nstr利用していないファイル名を取得 = strtempFilename
            Exit Function
        End If
    Next
    nstr利用していないファイル名を取得 = ""
End Function

'
'   機能　　　:  ファイルの存在確認
'
'    返り値　　:     TRUE:ファイルがあるとき
'                   　FALSE:ファイルがないとき
'    引き数　　:    ByVal pstrファイル名 As String　確認するファイル名（フルパス推奨）
'
'    機能説明　:     ワイルドカードは使えません
'
'
'    備考　　　:     -
'
'    この関数のURL　　：https://pgbigoroku.hatenablog.com/entry/2022/08/17/005434
'
'    この関数を利用するために必要な関数：
'
'    バージョン　　：2022/8/15
'
Private Function nblnファイル存在確認(ByVal pstrファイル名 As String) As Boolean
    Dim FSO As Object ' Scripting.FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(pstrファイル名) = True Then
        nblnファイル存在確認 = True
    Else
        nblnファイル存在確認 = False
    End If
    Set FSO = Nothing
End Function

'フォルダの存在確認
'
'バージョン　2022/8/17
'URL    https://pgbigoroku.hatenablog.com/entry/2022/08/17/005046

Private Function nblnフォルダの存在確認(ByVal pstr検索フォルダ名 As String) As Boolean
    Dim objFso
    Set objFso = CreateObject("Scripting.FileSystemObject")
    nblnフォルダの存在確認 = objFso.FolderExists(pstr検索フォルダ名)
 End Function

'   機能　　　:  フォルダ名とファイル名からフルパスにする
'
'    返り値　　:     -
'
'    引き数　　:    ByVal pstrフォルダ名 As String
'                   ByVal pstrファイル名 As String
'    機能説明　:　  フォルダ名の最後に\をついているか判定し　　-
'　　　　　　　　　フルパスにする。
'
'    備考　　　:     -
'
'    この関数のURL　　：　https://pgbigoroku.hatenablog.com/entry/2022/08/17/093728
'
'    この関数を利用するために必要な関数：
'
'    バージョン　　：2022/8/17
'
Private Function nstrフルパスにする(ByVal pstrフォルダ名 As String, ByVal pstrファイル名 As String) As String
    If Right(pstrフォルダ名, 1) = "\" Then
        nstrフルパスにする = pstrフォルダ名 & pstrファイル名
    Else
        nstrフルパスにする = pstrフォルダ名 & "\" & pstrファイル名
    End If
End Function