vba - CDate 函数字符串转换

Question

我正在导入电子邮件的正文。我想做的是将文本的日期部分转换为实际的日期格式。我正在使用以下代码进行转换：

If InStr(1, abody(j), "Start Date/Time:", 1) Then
StartDate = Mid(abody(j), InStr(abody(j), "Start Date/Time:") + 17)
Me.DueDate = ParseWord(StartDate, 1, , True, True)
End If

这是我目前拥有的：

 If InStr(1, abody(j), "Start Date/Time:", 1) Then
 StartDate = Mid(abody(j), InStr(abody(j), "Start Date/Time:") + 17)
 Me.DueDate = ParseWord(StartDate, 1, , True, True)
 CDate(Replace(Replace([StartDate],"Start Date/Time: ",''),' at ',' '))
 End If

但我随后收到以下错误：

编译错误：
预期：标识符

以下是我要导入的电子邮件示例：

Transmit:  Date: 

*** R O U T I N E         *** Request No.: 123456789

Operators Notified: 


Start Date/Time:    01/01/18   At 00:15  Expiration Date: 01/01/18 

Location Information: 
County:     Municipality: 
Subdivision/Community:  
Street:               0 FAKE ST
Nearest Intersection: FAKE ST
Other Intersection:    
Lat/Lon: 
Type of Work: REPAIR  
Block:                Lot:                Depth: 2FT 

Extent of Work:  BEGINS 53FT W OF C/L OF INTERSECTION AND EXTENDS 785FT
 W.  MARK A 3FT RADIUS OF POLE NUMBERS 000/000, 000/000

Remarks:  
 Working For Contact:  NO ONE

Working For: NO ONE
Address:     123 FAKE ST
City:        SPRINGFIELD
Phone:       [phone]   Ext:  

Excavator Information: 
Caller:      NO ONE
Phone:       [phone]   Ext:  

Excavator:   NO ONE

Address:     123 FAKE ST
City:        SPRINGFIELD
Phone:       [phone]   Ext:          Fax:  
Cellular:     
Email:       [e-mail]

End Request

语法分析代码：

Function ParseWord(varPhrase As Variant, ByVal iWordNum As Integer, Optional strDelimiter As String = " ", _
    Optional bRemoveLeadingDelimiters As Boolean, Optional bIgnoreDoubleDelimiters As Boolean) As Variant
'On Error GoTo eRR_handler
    'Purpose:   Return the iWordNum-th word from a phrase.
    'Return:    The word, or Null if not found.
    'Arguments: varPhrase = the phrase to search.
    '           iWordNum = 1 for first word, 2 for second, ...
    '               Negative values for words form the right: -1 = last word; -2 = second last word, ...
    '               (Entire phrase returned if iWordNum is zero.)
    '           strDelimiter = the separator between words. Defaults to a space.
    '           bRemoveLeadingDelimiters: If True, leading delimiters are stripped.
    '               Otherwise the first word is returned as null.
    '           bIgnoreDoubleDelimiters: If true, double-spaces are treated as one space.
    '               Otherwise the word between spaces is returned as null.
    'Author:    Allen Browne. http://allenbrowne.com. June 2006.
    Dim varArray As Variant     'The phrase is parsed into a variant array.
    Dim strPhrase As String     'varPhrase converted to a string.
    Dim strResult As String     'The result to be returned.
    Dim lngLen As Long          'Length of the string.
    Dim lngLenDelimiter As Long 'Length of the delimiter.
    Dim bCancel As Boolean      'Flag to cancel this operation.

    '*************************************
    'Validate the arguments
    '*************************************
    'Cancel if the phrase (a variant) is error, null, or a zero-length string.
    If IsError(varPhrase) Then
        bCancel = True
    Else
        strPhrase = Nz(varPhrase, vbNullString)
        If strPhrase = vbNullString Then
            bCancel = True
        End If
    End If
    'If word number is zero, return the whole thing and quit processing.
    If iWordNum = 0 And Not bCancel Then
        strResult = strPhrase
        bCancel = True
    End If
    'Delimiter cannot be zero-length.
    If Not bCancel Then
        lngLenDelimiter = Len(strDelimiter)
        If lngLenDelimiter = 0& Then
            bCancel = True
        End If
    End If

    '*************************************
    'Process the string
    '*************************************
    If Not bCancel Then
        strPhrase = varPhrase
        'Remove leading delimiters?
        If bRemoveLeadingDelimiters Then
            strPhrase = Nz(varPhrase, vbNullString)
            Do While Left$(strPhrase, lngLenDelimiter) = strDelimiter
                strPhrase = Mid(strPhrase, lngLenDelimiter + 1&)
            Loop
        End If
        'Ignore doubled-up delimiters?
        If bIgnoreDoubleDelimiters Then
            Do
                lngLen = Len(strPhrase)
                strPhrase = Replace(strPhrase, strDelimiter & strDelimiter, strDelimiter)
            Loop Until Len(strPhrase) = lngLen
        End If
        'Cancel if there's no phrase left to work with
        If Len(strPhrase) = 0& Then
            bCancel = True
        End If
    End If

    '*************************************
    'Parse the word from the string.
    '*************************************
    If Not bCancel Then
        varArray = Split(strPhrase, strDelimiter)
        If UBound(varArray) >= 0 Then
            If iWordNum > 0 Then        'Positive: count words from the left.
                iWordNum = iWordNum - 1         'Adjust for zero-based array.
                If iWordNum <= UBound(varArray) Then
                    strResult = varArray(iWordNum)
                End If
            Else                        'Negative: count words from the right.
                iWordNum = UBound(varArray) + iWordNum + 1
                If iWordNum >= 0 Then
                    strResult = varArray(iWordNum)
                End If
            End If
        End If
    End If

    '*************************************
    'Return the result, or a null if it is a zero-length string.
    '*************************************
    If strResult <> vbNullString Then
        ParseWord = strResult
    Else
        ParseWord = Null
    End If

Exit_Handler:
    Exit Function

'eRR_handler:
'    Call LogError(Err.Number, Err.Description, "ParseWord()")
'    Resume Exit_Handler
End Function

标签： vbams-access

Answer 1

这是一个单行：

Public Function ParseDate(ByVal Text As String) As Date

    ParseDate = CDate(Replace(Split(Split(Text, "Start Date/Time:", 2)(1), "Expiration Date:")(0), "At", ""))

End Function

当然，您可能希望包含一个错误处理程序。