vbscript: how to convert a date into days and time - vbscript

I have last boot time from WMI and it looks as '20141103113859.220250+060'. i want to convert it to number of days and time from the current time.
is it possible?

From Help
Use the SWbemDateTime object to convert these to regular dates and times.
Windows 2000/NT and Windows 98/95: SWbemDateTime is not available. To convert WMI dates to FILETIME or VT_DATE format or to parse the date into component year, month, day, hours, and so on, you must write your own code.
Set dtmInstallDate = CreateObject( _
"WbemScripting.SWbemDateTime")
strComputer = "."
Set objWMIService = GetObject( _
"winmgmts:\\" & strComputer & "\root\cimv2")
Set objOS = objWMIService.ExecQuery( _
"Select * from Win32_OperatingSystem")
For Each strOS in objOS
dtmInstallDate.Value = strOS.InstallDate
Wscript.Echo dtmInstallDate.GetVarDate
Next
To get help.
http://msdn.microsoft.com/en-us/windows/hardware/hh852363
Install the Windows SDK but just choose the documentation.

Next simple function should work for any argument in valid CIM_DATETIME format.
Function WMIDateStringToDate(dtmDate)
WMIDateStringToDate = ( Left(dtmDate, 4) _
& "/" & Mid(dtmDate, 5, 2) _
& "/" & Mid(dtmDate, 7, 2) _
& " " & Mid(dtmDate, 9, 2) _
& ":" & Mid(dtmDate,11, 2) _
& ":" & Mid(dtmDate,13, 2))
End Function
An example:
InstallDate (wmi): 20141205231553.000000+060
InstallDate: 2014/12/05 23:15:53
However, a wmi query could return Null, e.g. VarType(dtmDate)=1 for a particular instance of a date; in next script is the function modified:
option explicit
Dim strWmiDate
strWmiDate = "20141103113859.220250+060"
Wscript.Echo strWmiDate _
& vbNewLine & WMIDateStringToDate(strWmiDate) _
& vbNewLine & DateDiff("d", WMIDateStringToDate(strWmiDate), Now) _
& vbNewLine _
& vbNewLine & WMIDateStringToDate(Null) _
& vbNewLine & DateDiff("d", WMIDateStringToDate(Null), Now)
Function WMIDateStringToDate(byVal dtmDate)
If VarType(dtmDate)=1 Then
WMIDateStringToDate = FormatDateTime( Now) 'change to whatever you want
Else
'
' to keep script locale independent:
' returns ANSI (ISO 8601) datetime format (24 h)
'
' yyyy-mm-dd HH:MM:SS
'
WMIDateStringToDate = Left(dtmDate, 4) _
& "-" & Mid(dtmDate, 5, 2) _
& "-" & Mid(dtmDate, 7, 2) _
& " " & Mid(dtmDate, 9, 2) _
& ":" & Mid(dtmDate,11, 2) _
& ":" & Mid(dtmDate,13, 2)
End If
End Function
Output:
==>cscript 29535638.vbs
20141103113859.220250+060
2014-11-03 11:38:59
157
09.04.2015 15:36:38
0

#Serenity has given this same answer while i was writting, but ...
Option Explicit
WScript.Echo getLastBootUpTime()
WScript.Echo WMIDate2Date( "20141103113859.220250+060" )
WScript.Echo GetElapsedTime( getLastBootUpTime(), Now )
Function WMIDate2Date( ByVal WMIDate )
With WScript.CreateObject("WbemScripting.SWbemDateTime")
.Value = WMIDate
WMIDate2Date = .GetVarDate(False)
End With
End Function
Function getLastBootUpTime()
Dim oOS
For Each oOS In GetObject( "winmgmts:\\.\root\cimv2").ExecQuery("Select LastBootUpTime from Win32_OperatingSystem")
getLastBootUpTime = WMIDate2Date(oOS.LastBootUpTime)
Next
End Function
Function GetElapsedTime( ByVal Date1, ByVal Date2 )
Dim seconds, aLabels, aValues, aDividers, i
aLabels = Array( " days, ", ":", ":", "" )
aDividers = Array( 86400, 3600, 60, 1 )
aValues = Array( 0, 0, 0, 0 )
i = 0
seconds = Abs( DateDiff( "s", Date1, Date2 ))
Do While seconds > 0
aValues(i) = Fix( seconds / aDividers(i) )
seconds = seconds - aValues(i) * aDividers(i)
aValues(i) = CStr(aValues(i)) & aLabels(i)
i=i+1
Loop
GetElapsedTime = Join(aValues, "")
End Function

You won't get around splitting the WMI date string to make it to a date string that VBScript understands. Try this:
<%
wmiDate = "20141103113859.220250+060"
' note i am using date format: [m/d/Y H:m:s]
' if you prefer other format, i.e. [d.m.Y H:m:s] switch mid offsets
fromDate = Mid(wmiDate,5,2) & "/" & Mid(wmiDate,7,2) & "/" & Left(wmiDate,4)
fromTime = Mid(wmiDate,9,2) & ":" & Mid(wmiDate,11,2) & ":" & Mid(wmiDate,13,2)
toDate = Date & " " & Time
response.write(DateDiff("d",fromDate & " " & fromTime,toDate) & " Days<br />")
response.write(DateDiff("h",Date & " " & fromTime,toDate) & " Hours<br />")
%>
It uses Mid()and Left()functions to split WMI date into the needed parts for VBScript. Then the DateDiff() function will deliver the interval difference first for d= days and then for h= hours. You will notice when calculating hours i just used the time part of the WMI string, since we already calculated days difference, we only want hours left over.
Interesting article explaining VBScript Date and Time (Iso Formats)
As a comment was so kindly remarking the date format i used and the result of the hour calculation, i added a comment line explaining the date format i used (i used m/d/Y H:m:s but depending on your local, you might prefer d.m.Y H:m:s then you need to swap the Mid() offsets to get the right order). I also appended the current Time to the toDate and in the hour calculation prepended the current Date to calculate the correct time difference.

Related

CDate format creating problems in diff date [duplicate]

I have last boot time from WMI and it looks as '20141103113859.220250+060'. i want to convert it to number of days and time from the current time.
is it possible?
From Help
Use the SWbemDateTime object to convert these to regular dates and times.
Windows 2000/NT and Windows 98/95: SWbemDateTime is not available. To convert WMI dates to FILETIME or VT_DATE format or to parse the date into component year, month, day, hours, and so on, you must write your own code.
Set dtmInstallDate = CreateObject( _
"WbemScripting.SWbemDateTime")
strComputer = "."
Set objWMIService = GetObject( _
"winmgmts:\\" & strComputer & "\root\cimv2")
Set objOS = objWMIService.ExecQuery( _
"Select * from Win32_OperatingSystem")
For Each strOS in objOS
dtmInstallDate.Value = strOS.InstallDate
Wscript.Echo dtmInstallDate.GetVarDate
Next
To get help.
http://msdn.microsoft.com/en-us/windows/hardware/hh852363
Install the Windows SDK but just choose the documentation.
Next simple function should work for any argument in valid CIM_DATETIME format.
Function WMIDateStringToDate(dtmDate)
WMIDateStringToDate = ( Left(dtmDate, 4) _
& "/" & Mid(dtmDate, 5, 2) _
& "/" & Mid(dtmDate, 7, 2) _
& " " & Mid(dtmDate, 9, 2) _
& ":" & Mid(dtmDate,11, 2) _
& ":" & Mid(dtmDate,13, 2))
End Function
An example:
InstallDate (wmi): 20141205231553.000000+060
InstallDate: 2014/12/05 23:15:53
However, a wmi query could return Null, e.g. VarType(dtmDate)=1 for a particular instance of a date; in next script is the function modified:
option explicit
Dim strWmiDate
strWmiDate = "20141103113859.220250+060"
Wscript.Echo strWmiDate _
& vbNewLine & WMIDateStringToDate(strWmiDate) _
& vbNewLine & DateDiff("d", WMIDateStringToDate(strWmiDate), Now) _
& vbNewLine _
& vbNewLine & WMIDateStringToDate(Null) _
& vbNewLine & DateDiff("d", WMIDateStringToDate(Null), Now)
Function WMIDateStringToDate(byVal dtmDate)
If VarType(dtmDate)=1 Then
WMIDateStringToDate = FormatDateTime( Now) 'change to whatever you want
Else
'
' to keep script locale independent:
' returns ANSI (ISO 8601) datetime format (24 h)
'
' yyyy-mm-dd HH:MM:SS
'
WMIDateStringToDate = Left(dtmDate, 4) _
& "-" & Mid(dtmDate, 5, 2) _
& "-" & Mid(dtmDate, 7, 2) _
& " " & Mid(dtmDate, 9, 2) _
& ":" & Mid(dtmDate,11, 2) _
& ":" & Mid(dtmDate,13, 2)
End If
End Function
Output:
==>cscript 29535638.vbs
20141103113859.220250+060
2014-11-03 11:38:59
157
09.04.2015 15:36:38
0
#Serenity has given this same answer while i was writting, but ...
Option Explicit
WScript.Echo getLastBootUpTime()
WScript.Echo WMIDate2Date( "20141103113859.220250+060" )
WScript.Echo GetElapsedTime( getLastBootUpTime(), Now )
Function WMIDate2Date( ByVal WMIDate )
With WScript.CreateObject("WbemScripting.SWbemDateTime")
.Value = WMIDate
WMIDate2Date = .GetVarDate(False)
End With
End Function
Function getLastBootUpTime()
Dim oOS
For Each oOS In GetObject( "winmgmts:\\.\root\cimv2").ExecQuery("Select LastBootUpTime from Win32_OperatingSystem")
getLastBootUpTime = WMIDate2Date(oOS.LastBootUpTime)
Next
End Function
Function GetElapsedTime( ByVal Date1, ByVal Date2 )
Dim seconds, aLabels, aValues, aDividers, i
aLabels = Array( " days, ", ":", ":", "" )
aDividers = Array( 86400, 3600, 60, 1 )
aValues = Array( 0, 0, 0, 0 )
i = 0
seconds = Abs( DateDiff( "s", Date1, Date2 ))
Do While seconds > 0
aValues(i) = Fix( seconds / aDividers(i) )
seconds = seconds - aValues(i) * aDividers(i)
aValues(i) = CStr(aValues(i)) & aLabels(i)
i=i+1
Loop
GetElapsedTime = Join(aValues, "")
End Function
You won't get around splitting the WMI date string to make it to a date string that VBScript understands. Try this:
<%
wmiDate = "20141103113859.220250+060"
' note i am using date format: [m/d/Y H:m:s]
' if you prefer other format, i.e. [d.m.Y H:m:s] switch mid offsets
fromDate = Mid(wmiDate,5,2) & "/" & Mid(wmiDate,7,2) & "/" & Left(wmiDate,4)
fromTime = Mid(wmiDate,9,2) & ":" & Mid(wmiDate,11,2) & ":" & Mid(wmiDate,13,2)
toDate = Date & " " & Time
response.write(DateDiff("d",fromDate & " " & fromTime,toDate) & " Days<br />")
response.write(DateDiff("h",Date & " " & fromTime,toDate) & " Hours<br />")
%>
It uses Mid()and Left()functions to split WMI date into the needed parts for VBScript. Then the DateDiff() function will deliver the interval difference first for d= days and then for h= hours. You will notice when calculating hours i just used the time part of the WMI string, since we already calculated days difference, we only want hours left over.
Interesting article explaining VBScript Date and Time (Iso Formats)
As a comment was so kindly remarking the date format i used and the result of the hour calculation, i added a comment line explaining the date format i used (i used m/d/Y H:m:s but depending on your local, you might prefer d.m.Y H:m:s then you need to swap the Mid() offsets to get the right order). I also appended the current Time to the toDate and in the hour calculation prepended the current Date to calculate the correct time difference.

Classic Asp cookie expires date does not always get set

I am trying to set cookie with addheader -method in Classic Asp which is the only way of adding among other things HttpOnly and Secure -flags to cookies. All work with the below code - but there is one exception and its is the expiration date/time.
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & dateAdd("d", 365, Now()) & ";samesite=Strict;HostOnly"
%>
However, it seems to be browser-related issue. In firefox I can see in the Storage tab of developer tools that expiration time is set. But in Chrome it always stays as the default which is the expiration with the end of session. This same issue is with the Edge too.
Has anyone any experience with this issue?
The expected date format is documented here. You need to produce expiration date in that manner.
In Classic ASP, you can use server-side JavaScript to produce such dates easily.
<!--#include file="HTTPDate.asp"-->
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & HTTPDate(DateAdd("d", 365, Now())) & ";samesite=Strict;HostOnly"
%>
HTTPDate.asp
<script language="javascript" runat="server">
function HTTPDate(vbsDate){
return (new Date(vbsDate)).toGMTString().replace(/UTC/, "GMT");
}
</script>
Edit: Pure VBScript solution added.
<%
Function CurrentTZO()
With CreateObject("WScript.Shell")
CurrentTZO = .RegRead( _
"HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
End With
End Function
Function Pad(text)
Pad = Right("00" & text, 2)
End Function
Function HTTPDate(ByVal localDate)
localDate = DateAdd("n", CurrentTZO(), localDate)
' WeekdayName and MonthName functions relies on locale
' need to produce day and month name abbreviations in en-US locale
Dim locale : locale = SetLocale("en-US")
Dim out(5)
out(0) = WeekdayName(Weekday(localDate), True) & ","
out(1) = Pad(Day(localDate))
out(2) = MonthName(Month(localDate), True)
out(3) = Year(localDate)
out(4) = Join(Array(Pad(Hour(localDate)), Pad(Minute(localDate)), Pad(Second(localDate))), ":")
out(5) = "GMT"
SetLocale locale ' set original locale back
HTTPDate = Join(out, " ")
End Function
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & HTTPDate(DateAdd("d", 365, Now())) & ";samesite=Strict;HostOnly"
%>
In addition to the accepted solution of Kul-Tigin I want to add also a vbscript solution for those who are missing that too.
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & (New UTC).toUTCString(500,"d") & ";samesite=Strict;HostOnly;"
Class UTC
Public Function toUTCString(ByVal offSet, ByVal offsetType)
' ***********************************
' Converts vbScript datetime format to
' Universal datetime string format:
' Tue, 16 Feb 2021 13:39:24 GMT
'************************************
Dim dt: dt = dateAdd(offsetType, offSet, UTCDate(Now()))
Dim tdParts: tdParts = Split(dt, " ")
Dim tPart: tPart = CDate(tdParts(1) & " " & tdParts(2))
Dim dPart: dPart = CDate(tdParts(0))
Dim timeTo24: timeTo24 = _
Right("0" & Hour(tPart), 2) & ":" & _
Right("0" & Minute(tPart), 2) & ":" & _
Right("0" & Second(tPart), 2)
toUTCString = WeekdayName(Weekday(dPart), True) & ", " & _
Day(dPart) & " " & _
MonthName(Month(dPart), True) & " " & _
Year(dPart) & " " & _
timeTo24 & " GMT"
End Function
Public Function UTCDate(ByVal dtDate)
If Not IsDate(dtDate) Then Err.Raise 5
dtDate = CDate(dtDate)
Dim ZoneBias: ZoneBias = TimeZoneBias()
If IsPDT(Now) <> IsPDT(dtDate) Then
ZoneBias = ZoneBias - 60
End If
UTCDate = DateAdd("n", ZoneBias, dtDate)
End Function
Private Function IsPDT(ByVal dtDate)
If Not IsDate(dtDate) Then Err.Raise 5
dtDate = CDate(dtDate)
Dim pdtLow, pdtUpr, nDaysBack
pdtLow = DateSerial(Year(dtDate), 3, 31)
pdtUpr = DateSerial(Year(dtDate), 10, 31)
pdtLow = DateAdd("h", 2, pdtLow)
pdtUpr = DateAdd("h", 2, pdtUpr)
nDaysBack = Weekday(pdtLow) - 1
If nDaysBack <> 0 Then
pdtLow = DateAdd("d", -nDaysBack, pdtLow)
End If
nDaysBack = Weekday(pdtUpr) - 1
If nDaysBack <> 0 Then
pdtUpr = DateAdd("d", -nDaysBack, pdtUpr)
End If
IsPDT = (dtDate >= pdtLow And dtDate <= pdtUpr)
End Function
Private Function TimeZoneBias()
Dim LTZone
With GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\.\root\cimv2")
For Each LTZone In .ExecQuery(_
"Select * From Win32_ComputerSystem")
TimeZoneBias = LTZone.CurrentTimeZone
Next
End With
TimeZoneBias = TimeZoneBias * -1
End Function
End Class
%>

UTC Time Assignment in VBScript

Does anyone have a simple means in VBScript to get the current time in UTC?
Thanx,
Chris
I use a simple technique
Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
dateTime.SetVarDate (now())
wscript.echo "Local Time: " & dateTime
wscript.echo "UTC Time: " & dateTime.GetVarDate (false)
More info on SWbemDateTime
If you wanted to convert UTC back to local time do this:
Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
dateTime.SetVarDate now(),false REM Where now is the UTC date
wscript.echo cdate(dateTime.GetVarDate (true))
There are lots of examples out there. If you can access the registry this one will work for you:
od = now()
set oShell = CreateObject("WScript.Shell")
atb = "HKEY_LOCAL_MACHINE\System\CurrentControlSet\" &_
"Control\TimeZoneInformation\ActiveTimeBias"
offsetMin = oShell.RegRead(atb)
nd = dateadd("n", offsetMin, od)
Response.Write("Current = " & od & "<br>UTC = " & nd)
From http://classicasp.aspfaq.com/date-time-routines-manipulation/how-do-i-convert-local-time-to-utc-gmt-time.html
You can get time bias from Win32_TimeZone WMI class.
myDate = "9/4/2013 17:23:08"
For Each objItem In GetObject(_
"winmgmts:\\.\root\cimv2").ExecQuery(_
"Select * from Win32_TimeZone")
bias = objItem.Bias
Next
myDate = DateAdd("n", bias, myDate)
WScript.Echo myDate
With SetVarDate the offset change due to transition to daylight saving time (from +060 to +120) occurred one hour too soon. The RegRead(HKLM\..\ActiveTimeBias) method was spot-on. If reproduction is desired, just put the pc clock on a time just before and just after the expected transition time and check the results.
Here is an example that formats the date to UTC as well. Note that you cannot format to a millesecond level with this.
Dim formattedDate
Dim utcDate
Set objShell = WScript.CreateObject("WScript.Shell")
Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
dateTime.SetVarDate(now())
utcDate = dateTime.GetVarDate(false)
wscript.echo "Local Time: " & dateTime
wscript.echo "UTC Time: " & utcDate
formattedDate = DatePart("yyyy",utcDate) & "-" & Right("0" & DatePart("m",utcDate), 2) & "-" & Right("0" & DatePart("d",utcDate), 2)
& "T" & Right("0" & DatePart("h",utcDate), 2) & ":" & Right("0" & DatePart("n",utcDate), 2)
& ":" & Right("0" & DatePart("s",utcDate), 2) & ".000+0000"
wscript.echo formattedDate
'results in a format that looks like this: 1970-01-01T00:00:00.000+0000
set dateTime=Nothing
set objShell=Nothing
Based on above functions - returns a delta-value to be added to the current time to return UTC.
Or call it with DATE+TIME to return UTC.
Call it once and store in a global variable to offset any date/time to UTC.
Conversely Subtract it from any UTC to get the time in the current time zone.
The additional ROUND towards the bottom is an attempt to compensate for floating point errors in the conversion to the nearest second.
Function Time_add_To_get_UTC(Optional DateTime = 0) ''as double
'' Returns value to add to current time to get to UTC
''Based on above functions : )
''return offset from current time to UTC
''https://stackoverflow.com/questions/15887700/utc-time-assignment-in-vbscript/22842128
Dim SWDT ''As SWbemDateTime
Dim dt ''As Date
Set SWDT = CreateObject("WbemScripting.SWbemDateTime")
dt = Date + Time()
SWDT.SetVarDate (dt)
Time_add_To_get_UTC = CDbl(SWDT.GetVarDate(False)) - CDbl(SWDT.GetVarDate(True))
Time_add_To_get_UTC = CDbl(Round(Time_add_To_get_UTC * 24 * 60 * 60, 0) / 24 / 60 / 60)
Time_add_To_get_UTC = DateTime + Time_add_To_get_UTC
End Function

Vbscript Month and Second Function to 3 decimal places

I am trying to write a vbscript that will write the date and time into a config file in specific way. I have been researching the web and have not been able to locate how to format the seconds function correctly. Not even sure if it is possible. Any help or references would be greatly appreciated. My question is, Is there a way to format the Month and Seconds Function so that month will display as MM if single number month and second will display 3 decimal places?
Here is what I have tried so far but it is invalid.
myDate = (Year(Now) & "-" & Month(date) & "-" & day(date) & "T" & Hour(Time) & ":" & Minute(time) & ":" & Second(time) ' Displays as YYYY-MM-DDTHH:MM:SS
second = FormatNumber(Second, 3)
write.write(myDate)
I need it to display as YYYY-MM-DDTHH:MM:SS.SSS. Thanks in advance.
Now() Accuracy in VBScript
It seems in vbscript the "Now()" function can be converted to double to provide this type of precision.
Use a pad function to pad with extra zero's. Use the timer for capturing the milliseconds.
Option Explicit
Dim timerNow, myNow, myDate
timerNow = cStr(cdbl(timer))
myNow = now()
myDate = (Year(myNow) & "-" & _
zeropad(Month(myNow),2) & "-" & _
zeroPad(day(myNow),2) & "T" & _
zeroPad(Hour(myNow),2) & ":" & _
zeroPad(Minute(myNow),2) & ":" & _
zeroPad(Second(myNow),2) & "." & _
left(split(timerNow, ".")(1),3)) ' Displays as YYYY-MM-DDTHH:MM:SS.SSS
Private Function zeroPad(byval strInput, byval padCount)
If len(strInput) < padCount Then
zeroPad = string(padCount - len(strInput), "0") & strInput
Else
zeroPad = strInput
End If
End Function
One thing could go wrong here: When the time is just jumping from n.999 to n+1.000 when myNow and timerNow are retrieved. Idealiter you would extract myNow from timerNow, but that is left as an exercize for the reader.
CStr(Year(Date())) & "-" & Right("0" & CStr(Month(Date())), 2) & "-" & Right("0" & CStr(Day(Date())), 2)
This code will create YYYY-MM-DD
I think you get the idea and will be able to add the time component yourself

Find time with millisecond using VBScript

I want to get time with millisecond
Currently using Timer() method but it just give access upto second
Any idea?
Please make sure i don't want to convert second into millisecond want to get with millisecond
In fact Timer function gives you seconds with milliseconds. Integer part of returned value is the number of seconds since midnight and the fraction part can be converted into milliseconds - just multiply it by 1000.
t = Timer
' Int() behaves exactly like Floor() function, i.e. it returns the biggest integer lower than function's argument
temp = Int(t)
Milliseconds = Int((t-temp) * 1000)
Seconds = temp mod 60
temp = Int(temp/60)
Minutes = temp mod 60
Hours = Int(temp/60)
WScript.Echo Hours, Minutes, Seconds, Milliseconds
' Let's format it
strTime = String(2 - Len(Hours), "0") & Hours & ":"
strTime = strTime & String(2 - Len(Minutes), "0") & Minutes & ":"
strTime = strTime & String(2 - Len(Seconds), "0") & Seconds & "."
strTime = strTime & String(4 - Len(Milliseconds), "0") & Milliseconds
WScript.Echo strTime
This uses the standard dateserial in vbs
'get a timeserial with milliseconds
d1= date+ timer/86400
Wscript.echo datestamp(d1)&" "& timestamp(d1)
function datestamp(d)
datestamp=year(d) &"/"& month(d) & "/" & day(d)
end function
function timestamp(d)
ymd=fix(d)
h=hour(d)
m=minute(d)
s=second(d)
timestamp=right("00" & h,2)&":"& right("00" & m,2)& ":" & right("00" & s,2)& ","& _
right("000"& 86400000*(d-timeserial(h,m,s)-ymd),3)
end function
Building upon MBu's answer, here's a Sub version. Sprinkle calls to this around your code for messages in the immediate window, so you can see where delays are happening.
' *** Debug.Print the time with milliseconds, and a message of your choice
Private Sub DebugPrintTime(strWhereFrom As String)
On Error GoTo ErrHandler
Dim sglTimer As Single
Dim sglWholeSecs As Single
Dim Millisecs As Variant ' as a variant, Len() will give the length of string representation of this value
Dim Seconds As Variant
Dim Minutes As Variant
Dim Hours As Variant
Dim strTime As String
sglTimer = timer
sglWholeSecs = Int(sglTimer)
Millisecs = Int((sglTimer - sglWholeSecs) * 1000)
Seconds = sglWholeSecs Mod 60
sglWholeSecs = Int(sglWholeSecs / 60)
Minutes = sglWholeSecs Mod 60
Hours = Int(sglWholeSecs / 60)
strTime = String(2 - Len(Hours), "0") & Hours & ":"
strTime = strTime & String(2 - Len(Minutes), "0") & Minutes & ":"
strTime = strTime & String(2 - Len(Seconds), "0") & Seconds & "."
strTime = strTime & String(3 - Len(Millisecs), "0") & Millisecs
Debug.Print strTime, strWhereFrom
Exit Sub
ErrHandler:
MsgBox "Error in Sub DebugPrintTime" & vbCrLf & Err.Description & vbCrLf & strWhereFrom
Err.Clear
End Sub

Resources