Jump to content
paulosemblano

Conexão SQL - ConnectionTimeout e CommandTimeout

Recommended Posts

paulosemblano

No Excel faço uma conexão SQL em uma pasta de trabalho com outra pasta de trabalho, conforme código abaixo.

Antes verifico se o arquivo existe ou se está aberto em rede.

Minha pergunta é: como e onde utilizo as propriedades ConnectionTimeout e CommandTimeout?

Se a conexão cair antes do tempo, como faço para verificar e onde insiro a verificação?

E se preciso verificar, antes de abrir a conexão, se a mesma está em aberto, pois outras pastas de trabalho também retornam via SQL os dados da mesma pasta de trabalho de origem: fiquei na dúvida se a conexão para os dados de origem é exclusiva da minha pasta de trabalho, ou se dá erro se outra pasta de trabalho também abriu ao mesmo tempo uma conexão com o mesmo arquivo de origem.

Obs.: o retorno de dados está funcionando perfeitamente.

'RETORNA OS DADOS
    'Instrução SQL
    stSQL = "Select * From [" & stNomePLan & "$]"
    stSQL = stSQL & "Where " & stNomeColOrigem & " =" & lgCodAlugueis
    stSQL = stSQL & "And Data Between #" & Format(dtDataInicio, "MM/DD/YYYY") & "#"
    stSQL = stSQL & "And #" & Format(dtDataFinal, "MM/DD/YYYY") & "#"
    'Cria a conexão
    Call EstabeleceConexao
    'Abre a conexão
    On Error Resume Next
    grsConsulta.Open stSQL, gcnConexaoPlan, adOpenKeyset, adLockOptimistic
'gcnConexaoPlan.CommandTimeout 30
    'Verifica se houve erro
    If Err.Number <> 0 Then
        MsgBox "ERRO!"
        On Error GoTo 0
        GoTo EncerraMacro
    End If
    On Error GoTo 0
    'Verifica se tem registros na planilha de origem
    If grsConsulta.RecordCount = 0 Then
        MsgBox "Operação cancelada! Não há dados a retornar!", vbCritical + vbOKOnly, "ERRO!"
        GoTo EncerraMacro
    End If
    'Limpa a planilha PlanLíquida
    gwsPlanLiquida.Cells.Clear
    'Insere os títulos das colunas
    For lgCols = 0 To grsConsulta.Fields.Count - 1
        gwsPlanLiquida.Cells(1, lgCols + 1).Value = grsConsulta.Fields(lgCols).Name
    Next lgCols
    'Insere os registros
    gwsPlanLiquida.Range("A2").CopyFromRecordset grsConsulta
    'Acerta a largura das colunas
    gwsPlanLiquida.Columns.AutoFit
    lgUltCol = gwsPlanLiquida.Cells(1, Columns.Count).End(xlToLeft).Column
    If lgUltCol > 1 Then
        For lgLoopCol = 1 To lgUltCol
            With gwsPlanLiquida
                .Columns(lgLoopCol).ColumnWidth = .Columns(lgLoopCol).ColumnWidth + 2
            End With
        Next lgLoopCol
    End If
    'Mensagem de encerramento
    MsgBox "Operação concluída com sucesso!", vbInformation + vbOKOnly, "OK"

Em outro módulo:

Public gcnConexaoPlan       As ADODB.Connection 'Variável de conexão
Public grsConsulta          As ADODB.Recordset 'Variável de Recordset
Public gstNomeCaminho       As String
Public gstNomeArquivo       As String


Sub EstabeleceConexao()
    Set gcnConexaoPlan = New ADODB.Connection
    Set grsConsulta = New ADODB.Recordset
    With gwsApoio
        gstNomeCaminho = .Range("B5").Value
        gstNomeArquivo = .Range("B4").Value
    End With
    With gcnConexaoPlan
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & gstNomeCaminho & Application.PathSeparator & gstNomeArquivo & _
        ";Extended Properties=Excel 12.0"
        .Open
    End With
End Sub

Sub EncerraConexao()
    gstNomeCaminho = ""
    gstNomeArquivo = ""
    If Not (grsConsulta Is Nothing) Then
      If (grsConsulta.State And adStateOpen) = adStateOpen Then grsConsulta.Close
      Set grsConsulta = Nothing
    End If
    If Not (gcnConexaoPlan Is Nothing) Then
      If (gcnConexaoPlan.State And adStateOpen) = adStateOpen Then gcnConexaoPlan.Close
      Set gcnConexaoPlan = Nothing
    End If
End Sub

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.