Help with VBScript date

J

jocph

Member
Local time
Today, 09:07
Joined
Sep 12, 2014
Messages
61
What is wrong with this code? I am finding the last file backup with date in the filename e.g. Filename_(2020-01-23).ext. I can extract the date expression from the filename but when I try to change it to date, it gives a different date. The code below is incomplete just showing the relevant bits.

Dim dteCounter, dteCounter2
'dim sLocale
'sLocale=getlocale()
'SetLocale "en-us"
dteCounter = GetLastFile("Man","d:\Data Backup\")
dteCounter = ((Right(Left(dteCounter,Len(dteCounter)-7),10)))
dteCounter = cdate(Month(dteCounter) & "/" & Day(dteCounter) & "/" & Year(dteCounter))
dteCounter2 = cdate("01/23/2020")

MsgBox "The date is: " & (dteCounter) & " : " & (dteCounter2)
'SetLocale sLocale

The message box gives me: The date is: 2/6/2020 : 1/23/2020

Tried to set locale but it still gives me 2/6/2020 instead of 1/23/2020
 
Extract to a new variable and work with that. Then you can inspect each part?
 
dteCounter = ((Right(Left(dteCounter,Len(dteCounter)-7),10)))
dteCounter = cdate(Month(dteCounter) & "/" & Day(dteCounter) & "/" & Year(dteCounter))

I would be really suprised if that works. You declared dtecounter as a variant. So in the first line it returns a variant string "2020-01-23". vba is pretty smart to know what you are trying but Month("2020-01-23") should not work.
How about
Code: 
dteCounter = dateSerial(split(dteCounter,"-")(0),split(dteCounter,"-")(1),split(dteCounter,"-")(2))
 
If I do this:
Code: 
Dim strDate, dteCounter, dteCounter2

strDate = "Manpower Data (2020-01-23).accdb"
strDate = Right(Left(strDate,Len(strDate)-7),10)
dteCounter = cdate(Month(strDate) & "/" & Day(strDate) & "/" & Year(strDate))
dteCounter2 = cdate("01/23/2020")

MsgBox "The date is: " & (dteCounter) & (dteCounter2)

It gives correct date.

But if I use this (posting whole code):

Code: 
Dim strDate, dteCounter, dteCounter2

strDate = GetLastFile("Man","d:\Data Backup\")
strDate = Right(Left(strDate,Len(strDate)-7),10)
dteCounter = cdate(Month(strDate) & "/" & Day(strDate) & "/" & Year(strDate))
dteCounter2 = cdate("01/23/2020")

Do until dteCounter > Date()
    IF dteCounter = Date() Then
        BackupData()
    End If
    dteCounter = dteCounter + 7
Loop
MsgBox "The date is: " & (dteCounter) & " : " & (dteCounter2)

Function BackupData()
    Dim objFSO
    Dim sSourceFolder
    Dim sDestFolder
    Dim sDBFile
    Dim sDateTimeStamp
    Const OVER_WRITE_FILES = True
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    sSourceFolder = "z:\Manpower\System"
    sBackupFolder = "d:\Data Backup"
    sDBFile = "Manpower Data"
    sDBFileExt = "accdb"
    sDateTimeStamp = cStr(Year(now())) & "-" & _
                    Pad(cStr(Month(now())),2) & "-" & _
                    Pad(cStr(Day(now()-1)),2)
    '                 Pad(cStr(Hour(now())),2) & _
    '                 Pad(cStr(Minute(now())),2) & _
    '                 Pad(cStr(Second(now())),2)
    
    'If the backup folder doesn't exist, create it.
    If Not objFSO.FolderExists(sBackupFolder) Then
        objFSO.CreateFolder(sBackupFolder)
    End If
    
    'Copy the file as long as the file can be found
    If objFSO.FileExists(sSourceFolder & "\" & sDBFile & "." & sDBFileExt) Then
        objFSO.CopyFile sSourceFolder & "\" & sDBFile & "." & sDBFileExt,_
                        sBackupFolder & "\" & sDBFile & " (" & sDateTimeStamp & ")." & sDBFileExt,_
                        OVER_WRITE_FILES
    End if
    
    sSourceFolder = "w:\System"
    sDBFile = "Welding Data"
    
    'Copy the file as long as the file can be found
    If objFSO.FileExists(sSourceFolder & "\" & sDBFile & "." & sDBFileExt) Then
        objFSO.CopyFile sSourceFolder & "\" & sDBFile & "." & sDBFileExt,_
                        sBackupFolder & "\" & sDBFile & " (" & sDateTimeStamp & ")." & sDBFileExt,_
                        OVER_WRITE_FILES
    End if
    
    Set objFSO = Nothing

End Function

Function Pad(CStr2Pad, ReqStrLen)
'Source: http://saltwetbytes.wordpress.com/2012/10/16/vbscript-adding-datetime-stamp-to-log-file-name/
    Dim Num2Pad
 
    Pad = CStr2Pad
    If len(CStr2Pad) < ReqStrLen Then
        Num2Pad = String((ReqStrlen - Len(CStr2Pad)), "0")
        Pad = Num2Pad & CStr2Pad
    End If
End Function

Function GetLastFile(pPrefix, pFolder)

    Dim cmdOutput

    '// Make sure folder has trailing "\"
    'If Right(pFolder, 1) <> "\" Then
    '    pFolder = pFolder & "\"
    'End If

    '// Use command prompt to get a directory listing, sorted in Z-A order and read all the output into a string variable
    cmdOutput = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & pFolder &  pPrefix & "*.*"" /A:-D /B /O:-N").StdOut.ReadAll

    '// Get the first line from the output
    GetLastFile = CStr(Split(cmdOutput, vbCrLf)(0))

End Function

It gives me 2/6/2020 instead of 1/23/2020. see attached screens.
 

Attachments

  • Explorer.JPG
    Explorer.JPG
    17.1 KB · Views: 153
  • msgbox.JPG
    msgbox.JPG
    11.7 KB · Views: 147
MajP said:
dteCounter = ((Right(Left(dteCounter,Len(dteCounter)-7),10)))
dteCounter = cdate(Month(dteCounter) & "/" & Day(dteCounter) & "/" & Year(dteCounter))

I would be really suprised if that works. You declared dtecounter as a variant. So in the first line it returns a variant string "2020-01-23". vba is pretty smart to know what you are trying but Month("2020-01-23") should not work.
How about
Code: 
dteCounter = dateSerial(split(dteCounter,"-")(0),split(dteCounter,"-")(1),split(dteCounter,"-")(2))
Click to expand...

Thanks for the reply but it still gives me 2/6/2020.

Maybe I should mention that my OS is Win10 LTSC, if that makes any difference.
 
jocph said:
If I do this:
Code: 
Dim strDate, dteCounter, dteCounter2

strDate = "Manpower Data (2020-01-23).accdb"
strDate = Right(Left(strDate,Len(strDate)-7),10)
dteCounter = cdate(Month(strDate) & "/" & Day(strDate) & "/" & Year(strDate))
dteCounter2 = cdate("01/23/2020")

MsgBox "The date is: " & (dteCounter) & (dteCounter2)
It gives correct date.
Click to expand...
if you don't declare specifics, doesn't it default to VARIANT? you are also throwing DATE data types to dteCounter and dteCounter2. then you're concatenating them into the msgbox string.
jocph said:
But if I use this (posting whole code):

Code: 
Dim strDate, dteCounter, dteCounter2

strDate = GetLastFile("Man","d:\Data Backup\")
strDate = Right(Left(strDate,Len(strDate)-7),10)
dteCounter = cdate(Month(strDate) & "/" & Day(strDate) & "/" & Year(strDate))
dteCounter2 = cdate("01/23/2020")

Do until dteCounter > Date()
    IF dteCounter = Date() Then
        BackupData()
    End If
    dteCounter = dteCounter + 7
Loop
MsgBox "The date is: " & (dteCounter) & " : " & (dteCounter2)
It gives me 2/6/2020 instead of 1/23/2020. see attached screens.
Click to expand...
what's the return type of the GetLastFile() function? I doubt it's a consequence of windows 10 acting strangely, although anything visual basic related has a lot of strange undocumented anomolies associated with it. maybe try to keep everything strictly consistent when dealing with your variables when they are intermingling with the functions? like:
Code: 
Dim strDate as string
dim dteCounter2 as string
dim dteCtrDateType as date

strDate = GetLastFile("Man","d:\Data Backup\")
strDate = Right(Left(strDate,Len(strDate)-7),10)
dteCtrDateType  = cdate(cstr(Month(strDate)) & "/" & cstr(Day(strDate)) & "/" & cstr(Year(strDate)))
dteCounter2 = "01/23/2020"

Do until dteCtrDateType  > Date()
    IF dteCtrDateType = Date() Then
        BackupData()
    End If
    dteCtrDateType  = dteCtrDateType  + 7
Loop
MsgBox "The date is: " & (cstr(dteCtrDateType)) & " : " & (dteCounter2)
does that work?
 
jocph,

I might have made a mistake in that last post. If I remember right, when i did a vbScript in windows, I seem to remember that it wouldn't let me declare vars as datatypes specifically, but rather just declared them with DIM. so if what I wrote:
Code: 
dim var as type
etc
etc...
doesn't work, sorry about that. Hopefully the rest can help you somewhat though.
 
Not sure why you do not think 2/6/2020 is not the correct answer. It is

Code: 
strDate = GetLastFile("Man","d:\Data Backup\")
strDate = Right(Left(strDate,Len(strDate)-7),10)
dteCounter = cdate(Month(strDate) & "/" & Day(strDate) & "/" & Year(strDate))
dteCounter2 = cdate("01/23/2020")

'Enter here with 1/23/2020
Do until dteCounter > Date()
    IF dteCounter = Date() Then
        BackupData()
    End If
   dteCounter = dteCounter + 7
Loop
MsgBox "The date is: " & (dteCounter) & " : " & (dteCounter2)

You enter the loop with 1/23/2020. First time through it is 1/30/2020. Still not greater than date. Loops second time and 2/6/2020.
 
if you're right.
Click to expand...
Of course it is right, it is doing exactly what they programmed. OP already said before entering the loop the value is correct. Then their code adds 14 days. I guess my question is what are they really trying to do. Why are they backing up data multiple times adding 7 days?
 
Yup you're right MajP! There's a lightbulb that suddenly lit in my head :)
The code is working now as intended. Thank you for the comments.
Here's my final code:
Code: 
Dim strDate, dteCounter

strDate = GetLastFile("Man","d:\Data Backup\")  'Get filename of latest backup
strDate = Right(Left(strDate,Len(strDate)-7),10) 'extract the date from the filename
dteCounter = dateSerial(split(strDate,"-")(0),split(strDate,"-")(1),split(strDate,"-")(2)) 'convert the expression to a date
dteCounter = dteCounter + 1 'add one day (because backups are done 1 day after filename date, I don't know why)

'If one week has passed since last backup, do the backup
Do until dteCounter > Date()
    IF dteCounter = Date() Then
        BackupData()
    End If
    dteCounter = dteCounter + 7
Loop

Function BackupData()
    Dim objFSO
    Dim sSourceFolder
    Dim sDestFolder
    Dim sDBFile
    Dim sDateTimeStamp
    Const OVER_WRITE_FILES = True
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    sSourceFolder = "z:\Manpower\System"
    sBackupFolder = "d:\Data Backup"
    sDBFile = "Manpower Data"
    sDBFileExt = "accdb"
    sDateTimeStamp = cStr(Year(now())) & "-" & _
                    Pad(cStr(Month(now())),2) & "-" & _
                    Pad(cStr(Day(now()-1)),2)
    '                 Pad(cStr(Hour(now())),2) & _
    '                 Pad(cStr(Minute(now())),2) & _
    '                 Pad(cStr(Second(now())),2)
    
    'If the backup folder doesn't exist, create it.
    If Not objFSO.FolderExists(sBackupFolder) Then
        objFSO.CreateFolder(sBackupFolder)
    End If
    
    'Copy the file as long as the file can be found
    If objFSO.FileExists(sSourceFolder & "\" & sDBFile & "." & sDBFileExt) Then
        objFSO.CopyFile sSourceFolder & "\" & sDBFile & "." & sDBFileExt,_
                        sBackupFolder & "\" & sDBFile & " (" & sDateTimeStamp & ")." & sDBFileExt,_
                        OVER_WRITE_FILES
    End if
    
    sSourceFolder = "w:\System"
    sDBFile = "Welding Data"
    
    'Copy the file as long as the file can be found
    If objFSO.FileExists(sSourceFolder & "\" & sDBFile & "." & sDBFileExt) Then
        objFSO.CopyFile sSourceFolder & "\" & sDBFile & "." & sDBFileExt,_
                        sBackupFolder & "\" & sDBFile & " (" & sDateTimeStamp & ")." & sDBFileExt,_
                        OVER_WRITE_FILES
    End if
    
    Set objFSO = Nothing

End Function

Function Pad(CStr2Pad, ReqStrLen)
'Source: http://saltwetbytes.wordpress.com/2012/10/16/vbscript-adding-datetime-stamp-to-log-file-name/
    Dim Num2Pad
 
    Pad = CStr2Pad
    If len(CStr2Pad) < ReqStrLen Then
        Num2Pad = String((ReqStrlen - Len(CStr2Pad)), "0")
        Pad = Num2Pad & CStr2Pad
    End If
End Function

Function GetLastFile(pPrefix, pFolder)

    Dim cmdOutput

    '// Make sure folder has trailing "\"
    If Right(pFolder, 1) <> "\" Then
        pFolder = pFolder & "\"
    End If

    '// Use command prompt to get a directory listing, sorted in Z-A order and read all the output into a string variable
    cmdOutput = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & pFolder &  pPrefix & "*.*"" /A:-D /B /O:-N").StdOut.ReadAll

    '// Get the first line from the output
    GetLastFile = CStr(Split(cmdOutput, vbCrLf)(0))

End Function
 
I am glad you got it working, but as far as I can tell their was no code issue it was an issue with you trying to run this code at an interval other than 7. I am guessing you only ever run this on a certain day of the week (like only on monday). If you miss that monday then you wait until next monday, but you cannot run it on any other day of the week. That was the original problem as far as I can tell. You tried to run the code 8 days from the last file name. So it looped through the code twice and dteCounter never = date and the backup never ran. I guess this makes sense as long as everyone knows that you can only run this application 7,14, 21 days from last time it was run.

So the confusion was not in code or logic, but in executing on the wrong day of the week. If it was me I would want to know this

Public Sub Demo()
Dim dteCounter As Date
Dim rtn As String
dteCounter = #1/25/2020#
If DateDiff("d", dteCounter, Date) Mod 7 <> 0 Then
rtn = "Last report was run on " & Format(dteCounter, "long date") & vbCrLf & "Today is " & Format(Date, "long date")
rtn = rtn & vbCrLf & "You can only run this backup on a " & Format(dteCounter, "dddd")
rtn = rtn & vbCrLf & "The weekday of running must be the same weekday as last report"
Debug.Print rtn
MsgBox rtn
Exit Sub
End If
Do Until dteCounter > Date
If dteCounter = Date Then
'backup data
End If
dteCounter = dteCounter + 7
Debug.Print dteCounter
Loop
End Sub
Click to expand...

The message is then:
Last report was run on Saturday, January 25, 2020
Today is Sunday, February 2, 2020
You can only run this backup on a Saturday
The weekday of running must be the same weekday as last report
Click to expand...
 
I am learning everyday. Thanks MajP! I'll take your advice and implement this.
 
So am I correct that your business rule is that you can only run the backup on the same weekday? Seems like you would need an override.
 
Yes we backup our database once a week on the same day. The script is in the task scheduler and runs daily. Backup is triggered when the current date is 7 days after the last backup.
 
Why not change the rule so it is 7 or more days since the last backup.
That will then cover issues where the backup couldn't run on the appointed day
 
isladogs said:
Why not change the rule so it is 7 or more days since the last backup.
That will then cover issues where the backup couldn't run on the appointed day
Click to expand...
Thank you for the suggestion! I'll modify it to do the backup if it finds that 7 or more days have elapsed since the last backup. That way in any event that the backup did not happen on the seventh day, it will do it on the first opportunity in the succeeding days.
 
Changed the logic to this:
Code: 
'If at least one week has passed since last backup, do the backup on the first opportunity
Do until i > 0 Date()
'Msgbox "1 The date is: " & dteCounter & " : " & Date()
    IF dteCounter >= Date() Then
        BackupData()
        i = 1
    End If
    dteCounter = dteCounter + 7
Loop
 
You must log in or register to reply here.

Similar threads

S
Anyone can help on this ? Total Date In Access
Replies
2
Views
250
Pat Hartman
P
W
Solved Duplicate Items in Query
Replies
5
Views
430
wmix
W
J
Query in Subreport help
Replies
17
Views
1,261
spaLOGICng
S
B
How to transpose row headings as column headings, cross tab query perhaps?
Replies
9
Views
701
June7
June7
Notiophilus
Solved Parametrised query: "type conversion failure" when inserting dates, e.g. Now()
Replies
6
Views
596
Notiophilus
Notiophilus

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom