Reputation: 119
I am trying to add to add French version to my code. I have macro that reads from text file report and extracts dates in correct format. Text file date format is JUL13/2023. My macro works just fine but sometimes dates appear in French - JAN - January, F:V – February, MAR - March, AVR - April, MAI- May, JUN - June, JLT - July, AO} – August, SEP – September, OCT – October, NOV - November, D:C – December. I am trying to find the best solution to add it into my code so it can read all possible dates and give me just regular date format as an output. Here is my code:
Sub test()
Dim fn As String, mtch As Object, m As Object, s As Object, txt As String
Dim i As Long
fn = "C:\temp\test.txt"
txt =CreateObject("scripting.filesystemobject").OpenTextFile(fn).ReadAll
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[^\n]+"
Set mtch = .Execute(txt)
i = 1
Dim b As Long
b = 1
For Each m In mtch
.Pattern = "[a-zA-Z0-9]{7}\s\s[^\s]+\s[a-zA-Z\s]*[0-9]{2}\/[0-9]{4}"
For Each s In .Execute(m.Value)
i = i + 1
Cells(i, 1) = s
b = b + 1
Range("B" & b).Value = Right(Cells(i, 1), 10)
Next
Next
End With
Dim var As String
Dim N As Long, p As Long, j As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For p = 2 To N
var = Range("B" & p).Value
Range("C" & p).Value = convert_date(var)
Range("D" & p).Value = Range("C" & p) + 179
Range("E" & p).Value = Range("C" & p) + 209
j = j + 1
Next p
End Sub
Function convert_date(date_as_string As String) As Date
Dim mthstring As String
mthstring = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC"
convert_date = DateSerial( _
CInt(Right(date_as_string, 4)), _
CInt(((InStr(1, mthstring, Left(date_as_string, 3)) - 1) / 4) + 1), _
CInt(Replace(Mid(date_as_string, 4, 2), "/", "")))
End Function
Sub testConvertDate()
Dim var As String
Dim N As Long, i As Long, j As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
Dim m As Integer
For i = 2 To N
'Range("B" & i).Value = Right("A" & i, 10)
var = Range("B" & i).Value
Range("C" & i).Value = convert_date(var)
Range("D" & i).Value = Range("C" & i) + 179
Range("E" & i).Value = Range("C" & i) + 209
j = j + 1
Next i
End Sub
Upvotes: 0
Views: 107
Reputation: 42256
Because of the fact that your French months name enumeration contains strings of 3 or 4 characters, you need to process the string Date
in a different way. Please, try the next adapted function. Do not miss to also copy the function returning only numbers (onlyNo
):
Function convert_date(date_as_string As String) As Date
Dim mthstring As String, strLeft As String, arrD, dayNo As Long, monthNo As Long, y As Long
mthstring = "JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC"
arrD = Split(mthstring, ",") 'place the string in an array
y = CLng(Split(date_as_string, "/")(1)) 'extract the year
strLeft = Split(date_as_string, "/")(0) 'extract the left string Date split by "/"
dayNo = onlyNo(strLeft) 'extract the day number
monthNo = Application.match(left(strLeft, Len(strLeft) - Len(CStr(dayNo))), arrD, 0) 'extract the month number
convert_date = DateSerial(y, monthNo, dayNo) 'convert to Date
End Function
Private Function onlyNo(strX As String) As Long
With CreateObject("vbscript.regexp")
.Pattern = "[^0-9]" 'replace everything except numbers
.Global = True
onlyNo = CLng(.replace(strX, "")) 'remove all letters
End With
End Function
The function should be called exactly as in your existing code.
You can simple test it using the next testing Sub. Please, uncomment the commented lines one by one and run it:
Sub testConvert_Date()
Dim d As String
d = "MAI31/2022"
'd = "JUIN20/2022"
'd = "NOV4/2022"
Debug.Print convert_date(d)
End Sub
If you need to adapt the function to work, at request, for English days name, too, I can easily adapt the function creating another parameter to select between languages.
Please, send some feedback after testing it.
Upvotes: 1
Reputation: 16322
Option Explicit
Function convert_date(s As String) As Date
Dim ar, arLang(1), regex, v
Dim y As Integer, m As String, d As Integer
arLang(0) = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC", ",")
arLang(1) = Split("JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC", ",")
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = False
.MultiLine = False
.Ignorecase = True
.Pattern = "([A-Z]+)(\d{1,2})\/(\d{4})"
End With
If regex.test(s) Then
With regex.Execute(s)(0)
m = .submatches(0)
d = .submatches(1)
y = .submatches(2)
End With
For Each ar In arLang
v = Application.Match(m, ar, 0)
If Not IsError(v) Then
convert_date = DateSerial(y, CInt(v), d)
Exit Function
End If
Next
End If
MsgBox s & " not correct format", vbExclamation
End Function
Upvotes: 0