✔ Programação GLOBAL®: VBA Tips - Retornando Milissegundos.

VBA Tips - Retornando Milissegundos.

| Blog Office VBA | Blog Excel | Blog Access |

Hello again 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étodoTimer):

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