Что то делаем в течении милисекунд

Private Sub DoSomeThingForSeveralMilliseconds()
' Что то делаем в течении милисекунд
' Do something for milliseconds
' -------------------------------------------------------------------------------------------------/
Dim dtEndDateTime As Date, dtTempTime As Date
Const iRunTimeInMilisecinds% = 353               ' Время выдаваемое на "Полезную работу" в ms
' -------------------------------------------------------------------------------------------------/
Dim datStart As Date, datEnd As Date, iVal%      ' Переменные только для "отчётности":

' Расчёт времени окончаеия работы (Дата-Время с точностью до ms):
    dtTempTime = iRunTimeInMilisecinds / 86400000   ' Перевод ms в формат Даты (дробная дата)
    dtEndDateTime = Date + CDate(Timer / 86400) + dtTempTime

'Дата-Время типа Now(), но с точностью до ms
    datStart = Date + CDate(Timer / 86400)       ' Время начала с точностью до ms (для "отчётности")
    
' Работа:
    dtTempTime = datStart
    Do While dtTempTime <= dtEndDateTime
        iVal = Year(Date) * 3 'Некая работа (проверка):
        
        'Пересчёт типа Now(), но с точностью до ms
        dtTempTime = Date + CDate(Timer / 86400)
    Loop
    
    datEnd = Date + CDate(Timer / 86400)         ' Время окончания с точностью до ms (для "отчётности")
    
' -------------------------------------------------------------------------------------------------/
' Отчёт (может быть небольшое расхождение с заданным iRunTimeInMilisecinds):
    iVal = Fix((datEnd - datStart) * 86400000)   ' Проделжительность в милисекундах (целое)
    Debug.Print "The run time was: " & iVal & " ms."
    
End Sub