paulosemblano 0 Posted March 10, 2020 Report Share Posted March 10, 2020 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 Link to post Share on other sites
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now