Date not formatting in VBA

The code below is not formating the date correctly on this line
eMailDate = Mnth & "/" & Dy & "/" & Right(eMailDate, 4)

It is showing 71/0/013

for 10/7/13

Is there a way to fix?  Thanks in advance



Public Function FindeMail() As Boolean
Dim pSplit As Integer, fSplit As Integer, iX As Integer, iBlank As Integer
Dim Delim As String, Mnth As String, Dy As String

Delim = "\"

   
    iDate = FileDateTime(iFile)
    iNow = Now()
    If iNow - iDate > 1 Then
        MsgBox iFile & " is not" & vbCrLf & "today's file"
        Exit Function
    End If

    pSplit = 1
    While pSplit > 0
        iX = pSplit
        pSplit = InStr(pSplit + 1, iFile, Delim)
    Wend
    eMailLong = iFile
    eMailTXT = Right(iFile, Len(iFile) - iX)
    eMailDate = Left(eMailTXT, Len(eMailTXT) - 4)
    eMailDate = Right(eMailDate, 8)
    Dy = Left(eMailDate, 2)
    Mnth = Left(Right(eMailDate, 6), 2)
    eMailDate = Mnth & "/" & Dy & "/" & Right(eMailDate, 4)
    eMailDir = Left(iFile, iX - 1)
    'MsgBox xWorkBook
FindeMail = True
leezacAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

unknown_routineCommented:
You need to provide details:

in
 eMailDate = Mnth & "/" & Dy & "/" & Right(eMailDate, 4)

What is the value of Mnth and eMailDate before this line executed?
0
FaustulusCommented:
If eMailDate is a Date then the way to format it would be like this,
Format(eMailDate, "mm/dd/yyyy")

While going through your code:
Note that Now() is a Double comprising of Date and Time, like 42333.23456
It looks to me like you intend to work with Date which returns a Long value like 42333.
1.23456 is > 1 but that isn't perhaps what you had in mind.

You have this code to set the value of pSplit
    While pSplit > 0
        iX = pSplit
        pSplit = InStr(pSplit + 1, iFile, Delim)
    Wend
I presume that you use it to extract the file extension. Try this instead:
Dim Arr() as String
Arr = Split(iFile, Delim)
This command splits iFile on the file separators.
The extension is Arr(Ubound(Arr)).
The nett file name will be Arr(Ubound(Arr)-1)

You can use the same method to get at the components of your eMailDate if they are in the wrong sequence.
Dim Arr() As String
Arr = Split(eMailDate, ".") - replace the dot with the date separator.
This will give you an array of 3 elements, Arr(0), Arr(1) and Arr(2).
Presuming that they are in d.M.Y order you would proceed like this:-
Format(DateSerial(Arr(2),Arr(1),Arr(0)), "mm/dd/yyyy")
DateSerial(Year, Month, Day) returns a Long representing a date which you can then format the way you please using the Format function.
0
leezacAuthor Commented:
emaildate shows as 071013 ( day, month, year) until this line

   eMailDate = Mnth & "/" & Dy & "/" & Right(eMailDate, 4)
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

unknown_routineCommented:
Ok then why you have


Right(emaildate, 4) ?


Define emaildate as string:

Dim emaildate As String

emaildate = "071013"

Dy = Left(emaildate, 2)         'Dy is now 07
mnth = Mid(emaildate, 3, 2) 'Mnth is now 10


Now you have correct month and day but here:

emaildate = mnth & "/" & Dy & "/" & Right(emaildate, 4)


result of  Right(emaildate, 4)  is 1013, so it is not the correct year.

it should be : Right(emaildate, 2) ,Since your year is 2 digits.

so use:

emaildate = mnth & "/" & Dy & "/" & Right(emaildate, 2)
0
leezacAuthor Commented:
I am getting confused with both posts, but using the last one - this is what I have now.

________________________________________________________

Dim pSplit As Integer, fSplit As Integer, iX As Integer, iBlank As Integer
Dim Delim As String, Mnth As String, Dy As String
Dim emaildate As String
Dim Arr() As String
Arr = Split(iFile, Delim)
'This command splits iFile on the file separators.
'The extension is Arr(Ubound(Arr)).
'The next file name will be Arr(Ubound(Arr)-1)


Delim = "\"

FindeMail = False

    iFile = Application.GetOpenFilename("Text Files (*.*), *.txt*")
   
    On Error Resume Next
    If iFile = "False" Then
        FindeMail = False
        MsgBox "No eMail text file selected for import"
        Exit Function
    End If
   
    iDate = FileDateTime(iFile)
    iNow = Now()
    If iNow - iDate > 1 Then
        MsgBox iFile & " is not" & vbCrLf & "today's file"
        Exit Function
    End If

    pSplit = 1
    While pSplit > 0
        iX = pSplit
        pSplit = InStr(pSplit + 1, iFile, Delim)
    Wend
    eMailLong = iFile
    eMailTXT = Right(iFile, Len(iFile) - iX)
    emaildate = Left(eMailTXT, Len(eMailTXT) - 4)
    emaildate = Right(emaildate, 8)
     Dy = Left(emaildate, 2)
    Mnth = Mid(emaildate, 3, 2)    

    emaildate = Mnth & "/" & Dy & "/" & Right(emaildate, 2)
    eMailDir = Left(iFile, iX - 1)
   
FindeMail = True
End Function
0
byundtMechanical EngineerCommented:
If your .txt filename might have a date with either two-digit or four-digit years, then you can handle both possibilities using this statement:
emaildate = Mnth & "/" & Dy & "/" & Mid(emaildate,5)

After declaring a number of undeclared variables, your function would become:
Function FindeMail() As Boolean
Dim pSplit As Integer, fSplit As Integer, iX As Integer, iBlank As Integer
Dim Delim As String, Mnth As String, Dy As String, iFile As String
Dim Arr() As String
Dim iDate As Double, iNow As Double
Dim eMailDir As String, eMailLong As String, eMailTXT As String, eMailDate As String
'This command splits iFile on the file separators.
'The extension is Arr(Ubound(Arr)).
'The next file name will be Arr(Ubound(Arr)-1)


Delim = "\"

FindeMail = False

    iFile = Application.GetOpenFilename("Text Files (*.*), *.txt*")
    Arr = Split(iFile, Delim)
    
    On Error Resume Next
    If iFile = "False" Then
        FindeMail = False
        MsgBox "No eMail text file selected for import"
        Exit Function
    End If
    
    iDate = FileDateTime(iFile)
    iNow = Now()
    If iNow - iDate > 1 Then
        'MsgBox iFile & " is not" & vbCrLf & "today's file"
        'Exit Function
    End If

    pSplit = 1
    While pSplit > 0
        iX = pSplit
        pSplit = InStr(pSplit + 1, iFile, Delim)
    Wend
    eMailLong = iFile
    eMailTXT = Right(iFile, Len(iFile) - iX)
    eMailDate = Left(eMailTXT, Len(eMailTXT) - 4)
    eMailDate = Right(eMailDate, 8)
    Dy = Left(eMailDate, 2)
    Mnth = Mid(eMailDate, 3, 2)

    eMailDate = Mnth & "/" & Dy & "/" & Mid(eMailDate, 5)
    eMailDir = Left(iFile, iX - 1)
   
FindeMail = True
End Function

Open in new window

0
FaustulusCommented:
CORRECTION:
I wrote,
Dim Arr() As String
Arr = Split(iFile, Delim)
'This command splits iFile on the file separators.
'The extension is Arr(Ubound(Arr)).
'The next file name will be Arr(Ubound(Arr)-1)
The hour must have been too late for my befuddled brain. I apologize!
Here is the corrected version:-
Dim Arr() As String
Arr = Split(iFile, Delim)
This command splits iFile on the file separators.
The file name, incl. extension, is Arr(Ubound(Arr)).

To get at the net file name and extension you can further split the file name.
Dim Fn() as String
Fn = split(Arr(Ubound(Arr)), ".")
The net file name will be  Fn(Ubound(Fn)-1)
and the extension, of course, Fn(Ubound(Fn))
0
FaustulusCommented:
Please add this function at the bottom of your code module.
Private Function GetMailDate(Mtext As String) As Long

    Dim Mdate As String
    Dim Mday As Integer
    Dim Mmonth As Integer
    Dim Myear As Integer
    
    Mdate = Left(Mtext, Len(Mtext) - 4)
    Mdate = Right(Mdate, 8)
    Mday = CInt(Left(Mdate, 2))
    Mmonth = CInt(Mid(Mdate, 3, 2))
    Myear = CInt(Right(Mdate, 4))
    GetMailDate = DateSerial(Myear, Mmonth, Mday)
End Function

Open in new window

In order to connect it with your own code, please remove the following portion of it,
        eMailTXT = Right(iFile, Len(iFile) - iX)
        emaildate = Left(eMailTXT, Len(eMailTXT) - 4)
        emaildate = Right(emaildate, 8)
         Dy = Left(emaildate, 2)
        Mnth = Mid(emaildate, 3, 2)
   
        emaildate = Mnth & "/" & Dy & "/" & Right(emaildate, 2)
and replace it with this,
        eMailTXT = Right(iFile, Len(iFile) - iX)
'        emaildate = Left(eMailTXT, Len(eMailTXT) - 4)
'        emaildate = Right(emaildate, 8)
'         Dy = Left(emaildate, 2)
'        Mnth = Mid(emaildate, 3, 2)
'    
'        emaildate = Mnth & "/" & Dy & "/" & Right(emaildate, 2)
        emaildate = Format(GetMailDate(eMailTXT), "mm/dd/yyyy")

Open in new window


In order to test the function I have supplied above use this little procedure.
Private Sub test()
    MsgBox Format(GetMailDate("This is something 09102013 but"), "mm/dd/yy")
End Sub

Open in new window

You can temporarily paste it at the bottom of your code sheet. Observe that the date in your eMailTXT must be without date separator, just like 09102013. If, in fact, you have a date like 09.10.2013 you should correct the extraction of Mday, Mmonth and Myear in my function.
0
leezacAuthor Commented:
Faustulus:

Nevermind
0
leezacAuthor Commented:
First, thanks for help. Second, I tested and


This code

 GetMailDate = DateSerial(Myear, Mmonth, Mday)


shows 13 for Myear, 91 for Mmonth, and 0 for Mday

This code

MsgBox Format(GetMailDate("This is something 09102013 but"), "mm/dd/yy")

shows 10/9/13

which is correct

I need for the emaildate to return 10/9/13
0
leezacAuthor Commented:
Faustulus, can you combine the code - it is a bit confusing.
0
FaustulusCommented:
Hello leezac,
Your project is still shrouded in mystery. Let me remind you that you asked about formatting a date, but not what you want that formatted date for. Nor did you tell us where to get the date from. In essence, you have given us code that doesn't work to explain what you want to do. In view of the above please forgive me for having cut through the knot resolutely. The following code will run, and it has a purpose. Whether it suits your needs is another question.
Option Explicit

Function FindMail() As Boolean

    Const Delim As String = "\"
    
    Dim Mname As Variant            ' Message: Full file name
    Dim Mdate As String             ' Message date
    Dim Mtext As String             ' Message text
    Dim Ffn() As String             ' split FullFileName

    FindMail = False
    Mname = Application.GetOpenFilename("Text Files (*.txt), *.txt*", 1, _
                                        "Open eMail File")
    If Mname = False Then
        MsgBox "No eMail text file selected for import"
        Exit Function
    End If
    
    Ffn = Split(Mname, Delim)
    Mdate = GetMailDate(Ffn(UBound(Ffn)))
    
    If Date - Mdate > 1 Then
        MsgBox Ffn(UBound(Ffn)) & vbCr & _
               "is not today's file."
        ' if today's file is required the Date must be = Mdate
    Else
        FindMail = True
    End If
End Function

Private Function GetMailDate(Mname As String) As Long

    Dim Mdate As String
    Dim Mday As Integer
    Dim Mmonth As Integer
    Dim Myear As Integer
    
    Mdate = Left(Mname, Len(Mname) - 4)
    Mdate = Right(Mdate, 8)
    Mday = CInt(Left(Mdate, 2))
    Mmonth = CInt(Mid(Mdate, 3, 2))
    Myear = CInt(Right(Mdate, 4))
    GetMailDate = DateSerial(Myear, Mmonth, Mday)
End Function

Open in new window

This code is designed to work on a text file with a name like
Description 09102013.txt
where "Description" is a string of any length and any composition.
The date must be of ddMMyyyy format, and it must be at the very end of the name.

The function will return True or False.
It will be True if the date in the file's name is today's date or yesterday's:-
If Date - Mdate > 1 Then
If you need it to be today's date please change this line to
If Date <> Mdate Then

I hope this helps you with your project of which this function must be a part.
0
leezacAuthor Commented:
Thanks - I am still testing.
0
leezacAuthor Commented:
All I need the code to do actually is get the date from the file and then it will be added to a button showing like " The file date of 10/7/13 has been imported.  

Per you last post - I did more checking.  the file date is showing with a 2 digit not 4 digit year.
0
leezacAuthor Commented:
This is the reason to extract the date - to go into this statement:

 Range("eMail").Value = "The " & eMailDate & " eMail has been imported successfully."
0
byundtMechanical EngineerCommented:
leezac,
Did you test the code I suggested in http:/Q_28261150.html#a39556588 ? It will work with both 2-digit and 4-digit years as the file name.

Brad
0
FaustulusCommented:
The code below incorporates the following modifications.
1. The date in the file name now has 6 characters ddmmyy
2. The function will write the requested message, "The 10/11/2013 eMail has been imported successfully.", where the date is that extracted from the file name.
Option Explicit

Private Sub Test()
    Debug.Print FindMail
End Sub

Function FindMail() As Boolean

    Const Delim As String = "\"
    
    Dim Mname As Variant            ' Message: Full file name
    Dim Mdate As String             ' Message date
    Dim Mtext As String             ' Message text
    Dim Ffn() As String             ' split FullFileName

    Mname = Application.GetOpenFilename("Text Files (*.txt), *.txt*", 1, _
                                        "Select eMail for import")
    If Mname = False Then
        MsgBox "No eMail text file selected for import"
        Exit Function
    End If
    
    Ffn = Split(Mname, Delim)
    Mdate = GetMailDate(Ffn(UBound(Ffn)))
    
    If Date - Mdate > 1 Then
        MsgBox Ffn(UBound(Ffn)) & vbCr & _
               "is not today's file."
        ' if today's file is required the Date must be = Mdate
    Else
         Range("eMail").Value = "The " & Format(Mdate, "mm\/dd\/yyyy") & _
         " eMail has been imported successfully."
        FindMail = True
    End If
End Function

Private Function GetMailDate(Mname As String) As Long

    Dim Mdate As String
    Dim Mday As Integer
    Dim Mmonth As Integer
    Dim Myear As Integer
    
    Mdate = Left(Mname, Len(Mname) - 4)
    Mdate = Right(Mdate, 6)
    Mday = CInt(Left(Mdate, 2))
    Mmonth = CInt(Mid(Mdate, 3, 2))
    Myear = CInt(Right(Mdate, 2))
    GetMailDate = DateSerial(Myear, Mmonth, Mday)
End Function

Open in new window

Your request to address, "Range("eMail")" and set its value requires that your ActiveSheet has a named range by the name of eMail. If it doesn't the code will fail. After setting up that named range you can run the procedure Test. You must have a properly named TXT file to import. You can add code to actually import the file right next to the code that is writing the confirmation of import.

Note that the function will returns True if the file was imported. You may require this return somewhere in your project. If not, there is no harm in its going unused.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
leezacAuthor Commented:
Thank you very much for time you spent in helping.  I have it working now.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.