Get Milliseconds In VBA

Do you ever find it hard to get the millisecond in your programs? In default VBA does not provide this function, however we can get it with some tricks. Create a module and add the following codes.

Private Type SystemTime  
    Year As Integer  
    Month As Integer  
    DayOfWeek As Integer  
    Day As Integer  
    Hour As Integer  
    Minute As Integer  
    Second As Integer  
    Milliseconds As Integer  
End Type  
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SystemTime)  

Then you add this function which return the total milliseconds of today.

Function GetTodayMilliseconds() As Long  
    Dim CurrentTime As SystemTime  
    GetSystemTime CurrentTime  
    GetTodayMilliseconds = Hour(Now) * 3600000 + _
                           Minute(Now) * 60000 + _
                           Second(Now) * 1000 + _
                           CurrentTime.Milliseconds
End Function  

Or you can add this if you need to calculate time interval of more then one day. It returns the total millisecond of the whole current month.

Function GetThisMonthMilliseconds() As Long  
    Dim CurrentTime As SystemTime  
    GetSystemTime CurrentTime  
    Function GetTodayMilliseconds() As Long  
    Dim CurrentTime As SystemTime  
    GetSystemTime CurrentTime  
    GetTodayMilliseconds = Day(Now) * 86400 + _
                       Hour(Now) * 3600000 + _
                       Minute(Now) * 60000 + _
                       Second(Now) * 1000 + _
                       CurrentTime.Milliseconds
End Function  

After all, you can get the milliseconds of today and the current month with the following tester.

Sub MillisecondTester()
    Dim CurrentTime As SystemTime
    GetSystemTime CurrentTime
    MsgBox Hour(Now) & ":" & _
           Minute(Now) & ":" & _
           Second(Now) & "." & _
           CurrentTime.Milliseconds & " = " & _
           GetTodayMilliseconds
    GetSystemTime CurrentTime
    MsgBox "Day " & Day(Now) & ", " & _
           Hour(Now) & ":" & _
           Minute(Now) & ":" & _
           Second(Now) & "." & _
           CurrentTime.Milliseconds & " = " & _
           GetThisMonthMilliseconds
End Sub