LoginSignup
0
2

More than 5 years have passed since last update.

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

Posted at

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
0
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
2