'ファイル更新日付チェック。ファイルが更新されていた場合、更新フラグをtrueにする。
Sub ChackCreateDate()
'File変数
Dim objFso As New FileSystemObject
Dim objFolder As Object
Dim objFiles As Object
Dim objFile As file
Dim objDate As Date
Dim lastDate As String
Dim folderPath As String
Dim cn As ADODB.Connection
Dim rsi As ADODB.Recordset
Dim tbli As String
Dim strSql As String
Dim fileCnt As Integer, destFileCnt As Integer
Dim chkFlg As Integer
Dim chkMsg As String
'cn カレントDB指定
Set cn = Application.CurrentProject.Connection
Set rsi = New ADODB.Recordset
Set objFso = New FileSystemObject
tbli = "テーブル1"
strSql = "SELECT * FROM " & tbli & " WHERE マスタフラグ = true"
rsi.Open strSql, cn, adOpenDynamic, adLockOptimistic
While Not rsi.EOF
chkFlg = True
chkMsg = ""
folderPath = rsi![ファイルパス]
lastDate = rsi![最終更新日]
fileCnt = rsi![ファイル数]
Set objFolder = objFso.GetFolder(folderPath)
Set objFiles = objFso.GetFolder(folderPath).Files
For Each objFile In objFiles
'作成日時を取得
objDate = objFile.DateCreated
Debug.Print (objDate)
If CStr(objDate) > lastDate Then
'指定したフォルダ内のファイル数を取得する then
destFileCnt = objFso.GetFolder(folderPath).Files.Count
'ファイル件数チェック
If fileCnt <> 0 And fileCnt <> destFileCnt Then
chkMsg = chkMsg & "ファイル数(" & destFileCnt & "ファイル)が規定数(" & fileCnt & "ファイル)合いません。"
chkFlg = False
Else
chkMsg = "ファイルが最新です。"
chkFlg = True
End If
Else
chkFlg = False
End If
Exit For
Next objFile
rsi![更新フラグ] = chkFlg
rsi![メッセージ] = chkMsg
rsi.Update
rsi.MoveNext
Set objFiles = Nothing
Set objFolder = Nothing
Wend
rsi.Close
cn.Close
Set rsi = Nothing
Set cn = Nothing
Set objFso = Nothing
End Sub
