ファイルの作成日時と更新日時が微妙に違うので揃えたいときに使うvba

2023年5月21日 07:17

はじめに

日々仕事でvbaを書いているhiroです。毎日お疲れ様です。
業務で相手先から大量のファイルを受け取りました。そうするとまず始めるのは前回紹介したプロシージャでファイル名とフルパスをすべて取得することです。

そしてフォルダ名やファイル名から必要なファイルを見つけ出し、前回紹介したプロシージャのうちの「ファイル情報を取得するプロシージャ」を使ってファイル情報を取得します。
しかし、そもそもファイル名が同じファイルがたくさんあります。どれが最新のファイルなのか、どれが正しいのかを目で確認するのは非常に大変。さてどうすればよいか。今回はそんなときに使えそうなプロシージャをご紹介します。

ファイル情報の何が違うのか

「ファイル情報を取得するプロシージャ」は１）ファイル名　２）ファイル作成日時　３）ファイル更新日時　４）ファイルサイズ(バイト)　５）ファイル種類　６）拡張子　の６つの情報を文字列として取得し配列とします。
まず、ファイル情報が同じかどうかを確認するために、これら６つの要素を文字列としてつなげます（concat関数など使用）。そうすると文字列の１次元配列となる。その配列で重複している要素を消していけばいいのです（もちろん１つは残します）。ですが、消えないのです。困ったことに。

なぜこのような現象が起きるのか。取得したファイル情報のうち１）ファイル名　５）ファイル種類　６）拡張子　は同じファイル名であれば当然同じですから、その他の要素がどう違うのかを確認しました。すると、２）ファイル作成日時　３）ファイル更新日時　が違う。しかも数秒だけ違う。つまり相手方がファイルをアップロードする過程でちょっとずれてしまうのです。数秒だけずれていても、プログラムとしては「違う文字列」とみてしまうので、違うファイルだと認識してしまいます。

で、思いついたのは、数分ぐらいのずれは同じ日時に調整してしまえ、ということです。実際にファイル情報を変更するのではなく、ファイル情報を判断する過程のなかで、同じファイル名・ファイルサイズで、２）ファイル作成日時　３）ファイル更新日時が数秒違うだけのファイルは同じ日時に揃えてしまおうという考えです。

具体的なプロシージャ

取得したファイル情報は日時も文字列ですから、シリアル値に修正しないといろいろと面倒。まずは日時の文字列をシリアル値に変えるプロシージャをつくりました。

Function date_and_time_str_to_serial(ByVal txt As String) As Double
'date_and_time_str_to_serial: 文字列の日時をシリアル値に変更　ファイル作成日時など
Dim aa As Long, bb As Long, cc As Long, dd As Long, ee As Long, ff As Long, gg As Long
Dim txt1 As String, txt2 As String, txt3 As String, txt4 As String, txt5 As String, txt6 As String, txt7 As String, txt8 As String, txt9 As String, txt10 As String, txt11 As String, txt12 As String, txt13 As String, txt14 As String, txt15 As String
aa = CLng(Left(txt, 4))
bb = CLng(Mid(txt, 6, 2))
cc = CLng(Mid(txt, 9, 2))

txt1 = Mid(txt, 12, Len(txt) - 11)
dd = InStr(txt1, ":")

ee = CLng(Left(txt1, dd - 1))

txt2 = Mid(txt1, dd + 1, Len(txt1) - dd)
dd = InStr(txt2, ":")

ff = CLng(Left(txt2, dd - 1))
gg = CLng(Mid(txt2, dd + 1, Len(txt2) - dd))

date_and_time_str_to_serial = DateSerial(aa, bb, cc) + TimeSerial(ee, ff, gg)


End Function

ファイル情報として取得している日時は　"2023/05/15 13:52:20"　という表記になっていますから、"/"　や　":" の位置を使って、年月日、時分秒の数字を取り出し、DateSerial関数、TimeSerial関数でシリアル値に変えていく、というものです。このときは何となくsubstitute関数を使わずにできないかと思って上記の書き方になりました。

これで複数の同じファイル名に対してそれぞれの日時を配列にすることができました。型はdoubleにしています。シリアル値に小数点がありますから。この配列を代入して、数分の差は同じ配列にして返すプロシージャをつくりました。


Function five_minutes_adjustment(ByVal arrdb As Variant)
'five_minutes_adjustment: 時刻シリアル値による配列を代入し､５分以内の際は同じ時刻として扱い配列を返す double
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, g As Long
Dim aa As Long, bb As Long, cc As Long, dd As Long, ee As Long, ff As Long, gg As Long
Dim chkdb1st() As Double, chkdb2nd() As Double, chkdb3rd() As Double, chkdb4th() As Double, chkdb5th() As Double, chkdb6th() As Double, chkdb7th() As Double, chkdb8th() As Double, chkdb9th() As Double, chkdb10th() As Double, chkdb11th() As Double, chkdb12th() As Double, chkdb13th() As Double, chkdb14th() As Double, chkdb15th() As Double
Dim db1 As Double, db2 As Double, db3 As Double, db4 As Double, db5 As Double, db6 As Double, db7 As Double, db8 As Double, db9 As Double, db10 As Double, db11 As Double, db12 As Double, db13 As Double, db14 As Double, db15 As Double

cc = UBound(arrdb, 1)


'funcmin_zero_included_double:0を含む1次元配列で最小値を調べる　double
db1 = Module1002.funcmin_zero_included_double(arrdb)



ReDim chkdb2nd(1 To cc)
For c = 1 To cc
If arrdb(c) = 0 Then
chkdb2nd(c) = 0
Else
chkdb2nd(c) = arrdb(c) - db1
End If
Next c

db2 = Module1002.funcmax_double(chkdb2nd)
db3 = TimeSerial(0, 5, 0) '5分

ReDim chkdb3rd(1 To cc)
If db2 > db3 Then
For c = 1 To cc
chkdb3rd(c) = arrdb(c)
Next c
Else
For c = 1 To cc
If arrdb(c) = 0 Then
chkdb3rd(c) = 0
Else
chkdb3rd(c) = db1
End If
Next c
End If

five_minutes_adjustment = chkdb3rd



End Function

プロシージャのタイトルは「five_minutes_adjustment」つまり「5分を調整」という意味です。5分に特に意味はなく、今回は30秒でもいいのですが、手作業でファイルコピーするなどの場合もあると思うので5分としました。
内容は割と簡単で、まずは配列のなかでの最小値を求める。そして各要素と最小値の差が５分（シリアル値）より小さければ、最小値とする、というものです。最大値も同時に求めて、最大値が５分（シリアル値）より大きい場合は、目視確認のためにいったん判断を保留する意味で、代入した配列を返すかたちにしています。
細かいところですが、最小値を求めるときに０を含む配列だと答えが０になってしまうので、以下のプロシージャもつくりました。０を最大値に置き換えたうえで最小値を求めるものです。

Function funcmin_zero_included_double(ByVal arrdb As Variant) As Double
'funcmin_zero_included_double:0を含む1次元配列で最小値を調べる　double

Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, g As Long
Dim aa As Long, bb As Long, cc As Long, dd As Long, ee As Long, ff As Long, gg As Long
Dim chkdb1st() As Double, chkdb2nd() As Double, chkdb3rd() As Double, chkdb4th() As Double, chkdb5th() As Double, chkdb6th() As Double, chkdb7th() As Double, chkdb8th() As Double, chkdb9th() As Double, chkdb10th() As Double, chkdb11th() As Double, chkdb12th() As Double, chkdb13th() As Double, chkdb14th() As Double, chkdb15th() As Double
Dim db1 As Double, db2 As Double, db3 As Double, db4 As Double, db5 As Double, db6 As Double, db7 As Double, db8 As Double, db9 As Double, db10 As Double, db11 As Double, db12 As Double, db13 As Double, db14 As Double, db15 As Double

aa = UBound(arrdb, 1)

'funcmax_double:1次元配列で最大値を調べる　double
db1 = Module1002.funcmax_double(arrdb)




ReDim chkdb2nd(1 To aa)
For a = 1 To aa
If arrdb(a) = 0 Then
chkdb2nd(a) = db1
Else
chkdb2nd(a) = arrdb(a)
End If
Next a

ReDim chkdb3rd(1 To aa)

For a = 1 To aa
If a = 1 Then
chkdb3rd(a) = chkdb2nd(a)
Else
If chkdb2nd(a) < chkdb2nd(a - 1) Then
chkdb3rd(a) = chkdb2nd(a)
Else
chkdb3rd(a) = chkdb2nd(a - 1)
End If
End If
Next a

funcmin_zero_included_double = chkdb3rd(aa)

End Function

「five_minutes_adjustment」により戻ってくる配列の型はシリアル値なのでdoubleです。これをそのまま文字列としてもよいのですが、シリアル値のままだとわかりにくい。だからシリアル値の日時を文字列の日時表記に戻すプロシージャも作成しました。シリアル値から年などの情報を関数で取り出せばよいので割と簡単です。しかし、月・日は必ず２桁表記、時間などはそれに限定されないとわかったので、そこに注意しました。

Function date_and_time_serial_to_str(ByVal db1 As Double) As String
'date_and_time_serial_to_str: シリアル値日時を文字列に変更　"2023/05/15 13:52:20"　ファイル作成日時など
Dim aa As Long, bb As Long, cc As Long, dd As Long, ee As Long, ff As Long, gg As Long
Dim txt1 As String, txt2 As String, txt3 As String, txt4 As String, txt5 As String, txt6 As String, txt7 As String, txt8 As String, txt9 As String, txt10 As String, txt11 As String, txt12 As String, txt13 As String, txt14 As String, txt15 As String



If db1 = 0 Then
date_and_time_serial_to_str = ""
Else
txt1 = year(db1)
txt2 = Format(Month(db1), "00")
txt3 = Format(Day(db1), "00")
txt4 = Hour(db1)
txt5 = Minute(db1)
txt6 = Second(db1)
date_and_time_serial_to_str = txt1 & "/" & txt2 & "/" & txt3 & " " & txt4 & ":" & txt5 & ":" & txt6
End If

End Function

これでファイル情報のうち日時情報を調整することができました。最初の目論見通り、ファイル情報をつなげて比較し重複したものを消す作業をすると、例えば同じファイル名が６つあったところを１つに減らすことができました。

終わりに

「６つのファイル程度なら、ファイルを開いて目視で確認するほうが早いのでは」と思う方もいるでしょう。まず、同じファイル名を同時に開くのはちょっとテクニックが必要です（参考ページを引用します）。６つもあると大変ですね。

そして、６つのファイルを目視で確認できるでしょうか。たぶん多くの人は画面上では分からないので紙に出力して、紙にファイル名を書いて、にらめっこするでしょう。シートが複数あったら、そのすべてを確認しなければなりません。
最新のファイルだけにすればいいのでは？と思いがちですが、最新のファイルが常に正しいとは限らないのです。ファイルを更新したがなんだかうまくいかなくて「とりあえず」みたいなフォルダ名のところに保存しておこう、などという作業がないでしょうか。だから最新だという理由で信用するわけにもいかないのです。
そして単に６つのファイルだけならよいのですが、それを100回繰り返すとなればどうでしょうか。うんざりしませんか。
そのうんざりは必ずヒューマンエラーにつながります。「このファイルは正」と思い込んで作業をしていたら、あとから違うファイルが正だとわかったときの徒労感。それを味わいたくないで、数字で処理できるように、日々vbaを書いています。

ただそのプロシージャ自体が正しいのかも確認しないといけないし、個別のプロシージャが正しくても、おおもとの計算の流れがそれでいいのかは常に検証が必要です。まぁ間違っていたらどこかにエラーがでるので、人力で作業するよりマシと思っています。
参考にしていただければ幸いです。

この記事が気に入ったらサポートをしてみませんか？