开发者

Parse finnish date string to Date Type in VB6

开发者 https://www.devze.com 2023-04-04 16:59 出处:网络
I\'m getting a Finnish date string that looks like: 29.7.2011 9:27 I\'m trying to cast this string to a Date object in VB6. I\'ve tried using the Format function but it doesn\'t seem to swallow the

I'm getting a Finnish date string that looks like:

29.7.2011 9:27

I'm trying to cast this string to a Date object in VB6. I've tried using the Format function but it doesn't seem to swallow the date string or I'm doing something wrong. These are some appro开发者_JAVA百科aches I've tried:

theDate = Format(dateString, "General Date")

theDate = Format(dateString, "DD.MM.YYYY MM:HH")

Any ideas? Thanks.


Rather than manually parsing the string yourself, which is prone to errors, and which gets messy if you have to deal with multiple date formats, you can call out to the OLE Automation library (which VB6 uses internally for many things, including type conversions) to do the conversion for you. It can convert strings in any date/time format supported by Windows back into a raw Date.

Full disclosure: I agree with the sentiment in Deanna's answer: in general, you should try to use an unambiguous date/time format when converting dates to and from strings, but if you cannot do this for some reason, the solution outlined here should be fairly robust, as long as you know ahead of time what specific format the incoming date string will be in.

Below is an example of a DateFromString function that uses the VarDateFromStr function internally to convert a formatted date/time String into a Date.

Example Usage

Convert a Finnish date string to a Date and display it:

MsgBox DateFromString("29.7.2011 9:27", fl_FI)

On my machine (US English settings), this displays "7/29/2011 9:27 AM", which is the correct date and time (July 29).

Code

Place the code below into a new module (.bas file) in your project to use it. The code currently supports parsing US English (en_US) and Finnish (fl_FI) date strings, but you can add support for more locales if needed. See Locale IDs assigned by Microsoft for a complete list of locale ID's.


Option Explicit

Public Enum LocaleIDs
    en_US = &H409       ' English (United States)
    fl_FI = &H40B       ' Finnish
    ' [[ Add other Locale ID's here as needed ]] '
End Enum

Private Declare Function VarDateFromStr Lib "oleaut32.dll" ( _
    ByVal psDateIn As Long, _
    ByVal lcid As Long, _
    ByVal uwFlags As Long, _
    ByRef dtOut As Date) As Long

Private Const S_OK = 0
Private Const DISP_E_BADVARTYPE = &H80020008
Private Const DISP_E_OVERFLOW = &H8002000A
Private Const DISP_E_TYPEMISMATCH = &H80020005
Private Const E_INVALIDARG = &H80070057
Private Const E_OUTOFMEMORY = &H8007000E

'
' Converts a date string in the specified locale to a VB6 Date.
'
' Example:
'
'   Convert a Finnish date string as follows:
'
'   DateFromString("29.7.2011 9:27", fl_FI)
'
Public Function DateFromString(ByVal sDateIn As String, ByVal lcid As LocaleIDs) As Date

    Dim hResult As Long
    Dim dtOut As Date

    ' Do not want user's own settings to override the standard formatting settings
    ' if they are using the same locale that we are converting from.
    '
    Const LOCALE_NOUSEROVERRIDE = &H80000000

    ' Do the conversion
    hResult = VarDateFromStr(StrPtr(sDateIn), lcid, LOCALE_NOUSEROVERRIDE, dtOut)

    ' Check return value to catch any errors.
    '
    ' Can change the code below to return standard VB6 error codes instead
    ' (i.e. DISP_E_TYPEMISMATCH = "Type Mismatch" = error code 13)
    '
    Select Case hResult

        Case S_OK:
            DateFromString = dtOut
        Case DISP_E_BADVARTYPE:
            Err.Raise 5, , "DateFromString: DISP_E_BADVARTYPE"
        Case DISP_E_OVERFLOW:
            Err.Raise 5, , "DateFromString: DISP_E_OVERFLOW"
        Case DISP_E_TYPEMISMATCH:
            Err.Raise 5, , "DateFromString: DISP_E_TYPEMISMATCH"
        Case E_INVALIDARG:
            Err.Raise 5, , "DateFromString: E_INVALIDARG"
        Case E_OUTOFMEMORY:
            Err.Raise 5, , "DateFromString: E_OUTOFMEMORY"
        Case Else
            Err.Raise 5, , "DateFromString: Unknown error code returned from VarDateFromStr (0x" & Hex(hResult) & ")"
    End Select

End Function


You can use DateSerial and 'TimeSerial' in the following way

dateString = "29.7.2011 9:27"

Dim theDate as Date

dim yyyy as Integer
dim mm as Integer
dim dd as Integer
dim hh as integer
dim mm as integer

yyyy = mid(dateString,6,4)
mm = mid(dateString,4,1)
dd = mid(dateString,1,2)
hh = mid(dateString,11,1)
mm = mid(dateString,13,2)

theDate = DateSerial(yyyy,mm,dd) + TimeSerial(hh,mm,0)

now you theDate is a Date object and can be formatted the way you want

MsgBox Format(theDate,"yyyy-MMM-dd")  'This will display the a message with 2011-Jul-29

If your date string is not padded with zeros (for example: 2.4.2011 instead of 02.04.2011) then you will need to loop through the string to find the bits and parts of the date that you will be needing.


Finnish systems should be able to parse these correctly using CDate(). If you're parsing it on a non finnish system and the format is fixed, then you will need to split it up in code:

Dim Parts() as string, dateParts() As String, timeParts() as string
parts = Split(dateString, " ")
dateParts = Split(parts(0), ".") 
timeParts = Split(parts(1), ":")
theDate = DateSerial(dateParts(2), dateParts(1), dateParts(0)) + TimeSerial(timeParts(0), timeParts(1), 0)

You will probbaly want to add error handling and sanity checking to that but that is the basic idea.

Note that converting dates to and from string values will be error prone unless using very explicit unambigious agreed formats like ISO 8601, RFC 822 dates, and the iCal RFC 2445 standard.


Parsing is messy at best but here is a shorter sample how to do it

Private Sub Command1_Click()
    MsgBox Format$(TryParse("29.7.2011 9:27"), "yyyymmdd hh:mm:ss")
End Sub

Private Function TryParse(sFinnishDate As String) As Date
    Dim vSplit As Variant

    vSplit = Split(Replace(Replace(sFinnishDate, ".", " "), ":", " "))
    On Error Resume Next
    TryParse = DateSerial(vSplit(2), vSplit(1), vSplit(0)) + TimeSerial(vSplit(3), vSplit(4), 0)
    On Error GoTo 0
End Function
0

精彩评论

暂无评论...
验证码 换一张
取 消