VBA - Retornando Milissegundos.




Hello folks!

Medir o tempo de processamento de certos momentos dentro da nossa aplicação serve para otimizarmos nosso código, processos, acessos, etc.

Talvez deseje medir a performance de suas queries, ou a geração de arquivos em determinando processo de automação. Talvez queira saber qual interface comporta-se melhor no ambiente para o qual está desenvolvendo.

Como fazer isso, como medir, mensurar, detectar?

Fácil, a função abaixo lhe permitirá tal liberdade.






Public Function MilisSeconds() As String




Let 







MilisSeconds



 = Strings.Format(Now, "dd-MMM-yyyy HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)




End Function





Mas como posso aplicar isso nas minhas procedures e functions ? Segue exemplo:






Private Sub btnSave_Click()



    ' Author:                     Date:               Contact:



    ' André Bernardes             10/05/2011 15:31    bernardess@gmail.com     http://inanyplace.blogspot.com/



    ' Application: ********.



    ' Cria a **************************************.



    ' Listening: Recognizer - Daft Punk - Tron Legacy.







    Dim nStart As String







    DoCmd.RunCommand acCmdSaveRecord







    Let nStart = Right(TimeInMS(), 11) 'Right(Now(), 8)



    



    Call AdjustSpecialties



    Call AssemblerCentralEngine



    Call AssemblerCentralEngine2



    Call SeedData                                                    ' Arquiva os dados para consulta e análise posteriores







    Me.cmbCenarios.Requery                                    ' Atualiza o Combo de Exclusão de cenários.



    Let Me.cxVersion.Value = Now() & " Versão 00"   ' Atualiza a caixa de texto onde se dá os nomes para novos cenários.







    MsgBox "Tabela criada com sucesso!" & Chr(10) & Chr(13) & _



           "" & Chr(10) & Chr(13) & _



           " TABELA: tbl_Bernardes" & Chr(10) & Chr(13) & _



           "" & Chr(10) & Chr(13) & _



           "CENÁRIO: " & ReturnVersion() & Chr(10) & Chr(13) & _



           "" & Chr(10) & Chr(13) & _



           "Iniciou em: " & nStart & " - Finalizou em: " & Right(TimeInMS(), 11) & Chr(10) & Chr(13) & _



           "" & Chr(10) & Chr(13) & _



           "Os dados foram preservados para análises posteriores." & Chr(10) & Chr(13) & _



           "", vbInformation, ".: Informação: Versão " & ReturnVersion()



End Sub




Existe um outro modo de ter este mesmo resultado, utilizando API e DLL. Não acredito que seja mais útil, mas em todo caso, teste-o você mesmo se desejar:






Private Type SYSTEMTIME




wYear As Integer




wMonth As Integer




wDayOfWeek As Integer




wDay As Integer




wHour As Integer




wMinute As Integer




wSecond As Integer




wMilliseconds As Integer




End Type




Private Declare Sub GetSystemTime Lib "kernel32" 



(lpSystemTime As SYSTEMTIME)







Public Function nMillisecond() As String




Dim tSystem As SYSTEMTIME




Dim nRet





On Error Resume Next





GetSystemTime tSystem





Let sRet = Hour(Now()) & ":" & Minute(Now()) & ":" & Second(Now()) & _




":" & tSystem.wMilliseconds





Let nMillisecond = nRet




End Function




Vocês sabem como sou, se existe um outra forma, e a conheço, não deixo de lhes mostrar (medindo processamento em centésimos de segundos com o método Timer):






Public Sub TestBernardes()



    Dim fTimeStart As Single



    Dim fTimeEnd As Single




    Let fTimeStart = Timer



    




SomeProcedure




    








Let 
fTimeEnd = Timer



    
Debug.Print Format$((fTimeEnd - fTimeStart) * 100!, "0.00 "" Centésimos de segundos""")



End Sub







Public Sub SomeProcedure()



    Dim i As Long, r As Double



    For i = 0& To 10000000



        Let r = Rnd



    Next



End Sub





Tags: milissegundo, timer, milliseconds

Referências: VBAADUD
                      Excel Forum
                 Stack Overflow


Assuntos similares:





Calculating process time 



Excel VBA Timer



How to Get Time in Milliseconds using Excel VBA



How to add milliseconds to Now()



How to get milliseconds in VBA Now() function



Miliseconds in dim as date



Millisecond timer using VBA



Show current date & system time with milliseconds



Using Milliseconds in VBA



VBA Milliseconds



VBA Now() function



VBA Timer function






André Luiz Bernardes
A&A® - Work smart, not hard.


diHITT - Notícias