I'm programming a macro in vba, which makes the connection to a sql server database and makes a select in a table and returns me the time of the last change in the database. I created a program in vba that takes the system time and makes a calculation to show difference, the problem is that the loop should run every 5 min.
I used the Sleep
function. But it locks the worksheet during the mins placed within Sleep
.
I'd like to know if you have some way of not locking the worksheet using another function, or take that line of code Plan1.Range("A2").CopyFromRecordset
and assign a variable.
I have already used the Sleep
function and it crashes the program
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function conexao()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim sql As String
Dim hora As Date
Dim hora_banco As String
Dim total As Integer
Dim s As String
Dim hora_Inicial As Date
Dim Hora_final As Date
Dim strConn As String
'Atribui horas inicias e finais para as variaveis
hora_Inicial = TimeValue("8:00:00")
Hora_final = TimeValue("18:00:00")
'Pega a hora do sistema
hora = TimeValue(Time())
' faz a conexao com o banco
strConn = "Driver={SQL Server};Server=d1736368;Database=DB_CONSIGNADO_ESPECIFICO"
'abre a conexao
cn.Open strConn
'Cria o objeto Recordset
Dim rs, a As ADODB.Recordset
Set rs = New ADODB.Recordset
Set a = New ADODB.Recordset
'pega a hora do sistema
hora = Time()
Do Until hora_Inicial >= Hora_final
DoEvents
Application.Wait (Now + TimeValue("00:00:02"))
'faz o select no banco de dados e converte para hora
sql = "SELECT top 1 Convert(Char(8),GetDate(),114),(DT_SISTEMA) FROM T_PROPOSTA_FILHOTE"
'printa o valor das variaveis
Debug.Print hora
Debug.Print sql
'inicia o bloco with com a varivale rs
With rs
.ActiveConnection = cn
.Open sql
Plan1.Range("A2").CopyFromRecordset rs
.Close
End With
'recebe o ultima atualizacao de hora do banco
hora_banco = CDate(Range("A2").Value)
total = hora - (hora_banco = CDate(Range("A2").Value))
Debug.Print total
If total >= 5 Then
s = Shell("C:\teste\Reinicia_Robo.bat", vbNormalFocus)
End If
DoEvents
Loop
'fecha a conexao
cn.Close
Set rs = Nothing
Set cn = Nothing
End Function