VBA
access

Access VBA H29/03/04 というExcelの日付を日付として受け入れるための関数

Adodb.Recordsetなどを用いて、Excelからアクセスのテーブルへデータを受け入れることができます。
この時、Excelの日付表示が
H29/4/4 13:50

だとExcelが年月日として認識していてもうまくいきません。
この場合の方法は
a.Excelで表示形式を変換してからAccessに入れる
b.テキストとして受け入れ、フィールドの形式をDatetimeに変える。
C.関数を作り、変換する
という方法が考えられます。

今回はcを作りました。
fnGengoToDateTime ("H08/04/03 09:04")
fnGengoToDateTime ("H元/04/03 09:04")
こういう場合でも変換できます。
いうまでもなく改元を意識しています。

'For Access VBA
'日本の元号を西暦に変換します

Function fnGengoToDateTime(str) As Date
Dim buf As String, buf1 As String
Dim y2 As Long
Const Showa = 1925
Const Heisei = 1988
Const Taisho = 1912
Const Meiji = 1868
Const cnsG2019 = 2018
Dim REG: Set REG = CreateObject("Vbscript.RegExp")
Dim MC, M, iMc As Long
Dim TransferParameteter As Long
REG.Global = True
REG.MultiLine = False
REG.IgnoreCase = True
REG.Pattern = "(元|[0-9]{1,2}\b)"
Set MC = REG.Execute(str)
If MC.Count > 0 Then Set M = MC(0)
buf = Mid(str, 1, 1)
Select Case buf
Case Is = "昭", Is = "S", Is = "s"
TransferParameteter = Showa
Case Is = "平", Is = "H", Is = "h"
TransferParameteter = Heisei
Case Is = "M", Is = "明"
TransferParameteter = Meiji
Case Is = "T", Is = "大"
TransferParameteter = Taisho
'Case Is = "X", Is = "新" '<<<決定したら入れる
'TransferParameteter = cnsG2019
Case Else
Exit Function
End Select
'元年かどうかの処理と変換
If M.Value = "元" Then
y2 = 1
buf = Replace(str, buf & "元", y2 + TransferParameteter, 1, 1, vbTextCompare)
Else
y2 = M.Value
buf = Replace(str, buf & y2, y2 + TransferParameteter, 1, 1, vbTextCompare)
End If
fnGengoToDateTime = CDate(buf)
End Function