※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

TOOL_テキストファイル情報収集_ファイル情報取得クラス

  • ソース
Option Compare Database
Option Explicit

' GFI_FileInfoObject
' フォームの入力情報と、ファイル名を元に、ファイル情報を取得する
' 取得した情報は、レコードとしてテーブルに格納する
Private FVO As GFI_FormValueObject

Private FileName As String
Private FileSize As Long
Private RecordCount As Long
Private CreateDate As Date
Private LastUpdateDate As Date
Private CheckDate As Date

Private Sub class_initialize()
    ' なにもしません
End Sub

' InitFormInfo
' フォームの入力情報を取得する
' 引数:あり
' iFIO  :GFI_FormValueObject   :フォーム情報クラス
' 戻り値:なし
Public Sub InitFormInfo(ByVal iFIO As GFI_FormValueObject)
    Set FVO = iFIO
End Sub

' GetFileInfo
' 対象ファイルのファイル情報を取得する
' 引数:あり
' iFileName : String 対象のファイル名
' 戻り値:なし
Public Sub GetFileInfo(ByVal iFileName As String)
    ' 1.ファイル名設定
    FileName = iFileName
    
    ' 2.ファイルサイズ設定
    FileSize = FileLen(FVO.GetFolderPath & "\" & FileName)
    
    ' 3.行数カウント
    RecordCount = CountFileLine(FVO.GetFolderPath & "\" & FileName, _
                                FVO.GetHasHeaderLine)
    
    ' 4.作成日
    CreateDate = GetFileCreateDate(FVO.GetFolderPath & "\" & FileName)
    
    ' 5.最終更新日
    LastUpdateDate = GetFileLastUpdateDate(FVO.GetFolderPath & "\" & FileName)
    
    ' 6.調査日
    CheckDate = Now
End Sub

' CountDataFileLine
' 指定ファイルの行数をカウントする
' フラグにより、ファイルの構成に対応したカウントが可能
' ※純粋なレコード数0の場合はフラグ情報を考慮しない
' 引数:あり
' iFilePath : カウントする指定ファイル(フルパス)
' hasHeaderLine : ヘッダー行の有無(「TRUE:ヘッダー行あり」の場合1減らす)
' 戻り値:String:ファイルの行数
Public Function CountFileLine(ByVal iFilePath As String, ByVal hasHeaderLine As Boolean) As Long
    Dim fsObj As Object
    Dim fsObjTS As Object
    Dim LineNumber As Long
    
    ' 1.ファイルオブジェクトの初期化
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    
    ' 2.ファイルの末尾から読み込み専用モードで開きます
    Set fsObjTS = fsObj.OpenTextFile(iFilePath, 1, False, -1)
    
    ' 3.行数の初期化
    LineNumber = 0
    
    ' 4.末尾まで一行ずつ読み飛ばして、飛ばした数を行数とする
    Do While Not fsObjTS.AtEndOfStream
        fsObjTS.SkipLine
        LineNumber = LineNumber + 1
    Loop
    
    ' 4.ファイルを閉じる
    fsObjTS.Close
    
    ' 5.使用済みオブジェクトの除去
    Set fsObj = Nothing
    
    ' 6.チェックボックスの選択状況を行数に反映
    ' ※行数が1件以上の場合のみ対応
    If LineNumber > 0 Then
        ' A.読み込んだファイルの1行目(ヘッダー)をカウントしない
        If hasHeaderLine Then
            LineNumber = LineNumber - 1
        End If
    End If

    CountFileLine = LineNumber
End Function

' GetFileCreateDate
' テキストファイルの作成日を取得する
' 引数:あり
' iFilePath : カウントする指定ファイル(フルパス)
' 戻り値:Date:テキストファイルの作成日
Public Function GetFileCreateDate(ByVal iFilePath As String) As Date
    Dim fsObj As Object
    Dim tCreateDate As Date
    
    ' 初期化
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    
    ' ファイル作成日の取得
    tCreateDate = fsObj.GetFile(iFilePath).DateCreated
    
    ' 使用済みオブジェクトの除去
    Set fsObj = Nothing
    
    GetFileCreateDate = tCreateDate
End Function

' GetFileLastUpdateDate
' テキストファイルの最終更新日を取得する
' 引数:あり
' iFilePath : カウントする指定ファイル(フルパス)
' 戻り値:Date:テキストファイルの最終更新日
Public Function GetFileLastUpdateDate(ByVal iFilePath As String) As Date
    Dim fsObj As Object
    Dim tLastUpdateDate As Date
    
    ' 初期化
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    
    ' ファイル作成日の取得
    tLastUpdateDate = fsObj.GetFile(iFilePath).DateLastModified
    
    ' 使用済みオブジェクトの除去
    Set fsObj = Nothing
    
    GetFileLastUpdateDate = tLastUpdateDate
End Function

' CreateInfoRecord
' 取得済みのファイル情報をテーブルに格納する
' 引数:なし
' 戻り値:なし
Public Function CreateInfoRecord()
    Dim myDb As DAO.Database
    Dim strSQL As String
    Dim tableName As String
    
    Set myDb = CurrentDb
    tableName = "FileInfosList"
    strSQL = "Insert Into " & tableName & _
                " VALUES(" & _
                "'" & FVO.GetFolderPath & "', " & _
                "'" & FileName & "', " & _
                FileSize & ", " & _
                RecordCount & ", " & _
                "#" & Format(CreateDate, "yyyy/MM/dd hh:nn:ss") & "#, " & _
                "#" & Format(LastUpdateDate, "yyyy/MM/dd hh:nn:ss") & "#, " & _
                "#" & Format(CheckDate, "yyyy/MM/dd hh:nn:ss") & "#)"
    
    myDb.Execute strSQL
    
End Function


2013/05/13 更新
2013/05/14 更新
2013/05/15 全面改訂