日付フォーマットを列挙する

● 日付フォーマットを列挙する ●

何かに使えそうな気がするが、具体的に思いつかない。以下サンプルは Debug.Print にてイミディエイトウィンドウに表示するに留めた。必要があれば外部変数を用意するなりして改造してください。

'日付フォーマットを列挙する
Public Declare Function EnumDateFormats Lib "kernel32" Alias "EnumDateFormatsA" (ByVal lpDateFmtEnumProc As Long, ByVal Locale As Long, ByVal dwFlags As Long) As Long

'LOCALE_SYSTEM_DEFAULTの値を求める
Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long

'LOCALE_USER_DEFAULTの値を求める
Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

'メモリーコピー
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Const DATE_LONGDATE As Long = &H2   '長い日付形式
Public Const DATE_SHORTDATE As Long = &H1  '短い日付形式

'---------------------------------------------------------------------------
' 関数名： EnumDateFormatsProc
' 機能 ： 日付フォーマットを列挙する
' 引数 ： (in) lpDateFormatString … 日付文字列ヘのポインタ
' 返り値： 常に１(にしている)
'---------------------------------------------------------------------------
Public Function EnumDateFormatsProc(ByVal lpDateFormatString As Long) As Long

    Debug.Print GetStringFromPointer(lpDateFormatString)
    EnumDateFormatsProc = 1

End Function

'---------------------------------------------------------------------------
' 関数名： EnumDateFormatsProc
' 機能 ： 日付フォーマットを列挙する
' 引数 ： (in) lpString … 日付文字列ヘのポインタ
' 返り値： フォーマット形式の日付
'---------------------------------------------------------------------------
Private Function GetStringFromPointer(ByVal lpString As Long) As String

    Dim StrBuff As String * 256
    Dim DateFormat As String
    Dim OneChar As String
    Dim i As Long

    '文字列バッファを初期化
    StrBuff = String$(Len(StrBuff), Chr$(0))

    'メモリーコピー
    Call CopyMemory(ByVal StrBuff, ByVal lpString, ByVal Len(StrBuff))

    'Nullまで取得
    DateFormat = Left$(StrBuff, InStr(StrBuff, Chr$(0)) - 1)

    'なぜか"'"付きでかえされるので、"'"があれば取り除く
    If InStr(1, DateFormat, Chr$(39)) Then
        For i = 1 To Len(DateFormat)
            OneChar = Mid$(DateFormat, i, 1)
            If OneChar <> Chr$(39) Then
                GetStringFromPointer = GetStringFromPointer & OneChar
            End If
        Next i
        '現在日を指定して返す場合
        'GetStringFromPointer = Format$(Date, GetStringFromPointer)
    Else
        GetStringFromPointer = DateFormat
        '現在日を指定して返す場合
        'GetStringFromPointer = Format$(Date, DateFormat)
    End If

End Function

として、適当なプロシージャから呼び出す。

Private Sub Command1_Click()

    '短い日付形式
    Call EnumDateFormats(AddressOf EnumDateFormatsProc, GetSystemDefaultLCID, DATE_SHORTDATE)

    '長い日付形式
    Call EnumDateFormats(AddressOf EnumDateFormatsProc, GetSystemDefaultLCID, DATE_LONGDATE)

End Sub

戻る