RegularExpression

Private Sub felt1_BeforeUpdate(Cancel As Integer)
Select Case Left(felt1, 4)
Case Is <> "0044"
MsgBox Left(felt1, 4) & " er forkert start på data"
Case Is <> "0045"
MsgBox Left(felt1, 4) & " er forkert start på data"
Case Is <> "0047"
MsgBox Left(felt1, 4) & " er forkert start på data"
End Select
End Sub

Det var så ikke så svært alligevel:

Pattern skal være  \b[0][0][4][4-7][0-9]{8}\b

Det eneste er at den også godtager 0046, men det kan jeg leve med.

mugs> personligt synes jeg det er lidt 'smartere' at have en generel rutine til check af indtastninger der bare returnerer true eller false for om den er OK - man skal kune lige finde den rigtige pattern.

Hov det var det forkerte pattern - det rigtige er \b[0][0][4][4|5|7][0-9]{8}\b

(og så dropper den 0046)

For dem der evt. ikke er bekendt med fordelene ved at bruge RegEx kan jeg henvise til

http://www.regular-expressions.info/examples.html
http://www.fileformat.info/tool/regex.htm
http://www.regexbuddy.com/

Følgende funktion søger i en streng efter det angivne mønster og returnerer det fundne eller en tom streng.

Public Function fhpRegular_Expression_Find(strString_Search As String, strPattern As String) As String
' -----------------------------------------------------------------------------------
' Purpose    : Check a string for a regular expression
' Parameters :
' Returns    : String
' Created    : 07-08-2008
' Modified  :
' Remarks    : Set reference to 'Microsoft VBScript Regular Expression 5.5'
' -----------------------------------------------------------------------------------
On Error GoTo Error_fhpRegular_Expression_Find
  Dim rxRegExp As RegExp
  Dim rxMatches As MatchCollection
  Dim rxMatch As Match
  Dim strResult As String
 
  Set rxRegExp = New RegExp
 
  rxRegExp.IgnoreCase = True                                    'Upper and lower is OK
  rxRegExp.Global = False                                      'True = all matches  False = first match only
  rxRegExp.Pattern = strPattern
 
  Set rxMatches = rxRegExp.Execute(strString_Search)
 
  For Each rxMatch In rxMatches
    strResult = (rxMatch.Value)
  Next
 
  Set rxRegExp = Nothing
 
Exit_fhpRegular_Expression_Find:
  fhpRegular_Expression_Find = strResult
  Exit Function

Error_fhpRegular_Expression_Find:
  strResult = ""
  Select Case Err.Number
    Case 3021
    Case 2501
    Case Is < 0
    Case Else
      MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error in procedure 'fhpRegular_Expression_Find'"
  End Select
  Resume Exit_fhpRegular_Expression_Find

End Function

Må hellere lukke igen da jeg fandt svaret