Sleep function or Wait locking worksheet in Excel

0

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
    
asked by anonymous 17.10.2018 / 22:04

1 answer

0

Solution

The Wait function suspends Excel processing.

Then the following code alternative should be used to stop only the code and not the Excel Worksheet.

TempoEspera = Now() + TimeValue("00:00:10")
While Now() < TempoEspera
    DoEvents
Wend

Note

And to declare the Sleep function, do the following to avoid errors:

#If VBA7 Then  
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) '64 Bit  
#Else  
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) '32 Bit  
#End If  
    
17.10.2018 / 22:24