Eventualmente precisamos atualizar as tabelas de uma aplicação MS Access com dados oriundos de outras bases de dados, nem sempre essas informações estão facilmente disponíveis em Views ou Tables.
Inevitavelmente encontraremos informações que dependem de regras de negócio que consolidam os dados que desejamos atualizar em nossas aplicações, na maioria das vezes estas regras estão descritas em Stored Procedures e é por isso que precisamos aprender como utilizá-las. Como posso acessar estas informações através do código VBA?
ADO - Usando Procedimentos Armazenados
Call an Oracle stored procedure using VBA
Calling stored procedures from VBA
Execute SQL stored procedure in Access
Executing SQL Server Stored procedure from VBA
Executing Stored Procedures in Access VBA
Executing a Stored Procedure Containing Parameters
Get stored procedure output value back in VBA
How To Invoke a Stored Procedure with ADO Query Using VBA
How to Call an SQL Stored Procedure Using MS Access VBA
How to Use Stored Procedures with VBA
Passing parameters via VBA to a stored procedure
SQL Stored Procedure with Output Parameters
Stored procedure and VBA
Using stored procedures with VBA
Working with Stored Procedures in an MS Access Project
A técnica demonstrada abaixo é didática e aplicável, adapte-a a sua necessidade. Alguns aspectos do código podem e devem ser simplificados para acelerar a performance.
Estrutura de Tabela com 1 registro em branco gravado
Nome da Tabela: tbl_sys_addnome do campo | Tipo de dados | ConteúdonThing | Texto | 2 Active | Boolean | (true/false)TimeStamp | Data/Hora | (Dia e Hora)
Código do módulo' MÓDULO: mdl_sys_Connection' Microsoft® Office Access PAR Human Resource Planning Tool, developing by A&A - In Any Place.' Copyright© Promon Engenharia. All Rights Reserved.Public Colmn0 As VariantPublic Colmn1 As VariantPublic Colmn2 As VariantPublic Colmn3 As VariantPublic Colmn4 As VariantPublic Colmn5 As VariantPublic Colmn6 As VariantPublic Colmn7 As VariantPublic Colmn8 As VariantPublic Colmn9 As VariantPublic Colmn10 As VariantPublic Colmn11 As VariantOption Compare DatabaseFunction ReturnData()
' Author: Date: Contact:' André Bernardes 16/10/2008 07:45 bernardess@gmail.com' Retorna o conteúdo da PROC.' Fields: Registro, CPF, Nome, funcao, nivel_profis, Disciplina, data_admissao, data_demissao, lotacao, razao_soci, local_trabalhoOn Error GoTo Err_Execute ' Prepara para análise de erro.' Prepare variables.Dim db As DatabaseDim StrConection As StringDim StrConection1 As StringDim i, j As IntegerDim flag As BooleanDim nTx1, nTx2, nTx3, nTx4, nTx5, nTx6 As String' Busca parâmetros de conexão em formulário.Let nTx1 = [Form_frm_sys_SybaseImport].CxStoredProcedure.ValueLet nTx2 = [Form_frm_sys_SybaseImport].CxDSN.ValueLet nTx3 = [Form_frm_sys_SybaseImport].CxServer.ValueLet nTx4 = [Form_frm_sys_SybaseImport].CxDatabase.ValueLet nTx5 = [Form_frm_sys_SybaseImport].CxUser_ID.ValueLet nTx6 = [Form_frm_sys_SybaseImport].CxPassword.ValueLet flag = True' String de conexão.Let StrConection1 = "DSN=spod;" &; _"SRVR=spod;" &; _"DB=bdprom1;" &; _"UID=Cromon_engenharia;" &; _"PWD=Croeng01"Let StrConection = "DSN=" &; nTx2 &; ";" &; _"SRVR=" &; nTx3 &; ";" &; _"DB=" &; nTx4 &; ";" &; _"UID=" &; nTx5 &; ";" &; _"PWD=" &; nTx6' Ativando objeto da base de dados.Set db = DBEngine.Workspaces(0).OpenDatabase("", False, False, StrConection)' Executando a Stored ProcedureSet rs = db.OpenRecordset("EXEC " &; nTx1, dbOpenSnapshot, dbSQLPassThrough)' Laço no Recordset.Do Until rs.EOF' Retorna os Nomes dos campos, caso a linha de Debug seja habilitada.If flag ThenLet j = 1While j <= 11'Debug.Print rs(j).NameLet j = j + 1WendLet flag = False
End If
' Ao habilitar o Debug, este retornará o conteúdo dos campos.' Debug.Print i, rs(0).Value, rs(1).Value, rs(2).Value, rs(3).Value, rs(4).Value, rs(5).Value, rs(6).Value, rs(7).Value, rs(8).Value, rs(9).Value, rs(10).Value, rs(11).Value' Enviar mensagem para linha de status no FORM.[Form_frm_sys_SybaseImport].lblStatus.Caption = "|" &; Trim(Str(i)) &; "| " &; Now() &; " |" &; rs(0).Value &; " |" &; rs(1).Value &; " |" &; rs(2).Value &; " |" &; Trim(rs(3).Value) &; " |" &; rs(4).Value[Form_frm_sys_SybaseImport].Repaint[Form_frm_sys_SybaseImport].Refresh' Carrega variáveis definidas previamente como públicas, para a posterior utilização pela query "qry_sys_SetPeople".Let Colmn0 = Trim(rs(0).Value) 'Let Colmn1 = Trim(rs(1).Value) ' RegistroLet Colmn2 = Trim(rs(2).Value) ' CPFLet Colmn3 = Trim(rs(3).Value) ' NomeLet Colmn4 = Trim(rs(4).Value) ' funcaoLet Colmn5 = Trim(rs(5).Value) ' nivel_profisLet Colmn6 = Trim(rs(6).Value) ' DisciplinaLet Colmn7 = Trim(rs(7).Value) ' data_admissaoLet Colmn8 = Trim(rs(8).Value) ' data_demissaoLet Colmn9 = Trim(rs(9).Value) ' lotacaoLet Colmn10 = Trim(rs(10).Value) ' razao_sociLet Colmn11 = Trim(rs(11).Value) ' local_trabalho' Atualiza a tabela de Recursos Humanos.DoCmd.SetWarnings (False)DoCmd.OpenQuery "qry_sys_SetPeople", acViewNormal, acAddDoCmd.SetWarnings (True)' Avança uma linha no recordset.rs.MoveNext' Variável meramente informativa.Let i = i + 1Loop' Fecha Recordset e Base de dados.rs.CloseSet db = Nothing' Limpa as variáveis públicas.Let Colmn0 = NullLet Colmn1 = NullLet Colmn2 = NullLet Colmn3 = NullLet Colmn4 = NullLet Colmn5 = NullLet Colmn6 = NullLet Colmn7 = NullLet Colmn8 = NullLet Colmn9 = NullLet Colmn10 = Null' Mensagem para o usuário, identificando o término da atualização.MsgBox "Atualização terminada", vbInformation, "Colaboradores importados"Err_Execute:Call ErrorShow
End FunctionFunction ReturnField0()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.'Let ReturnField0 = Colmn0
End FunctionFunction ReturnField1()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' Registro.Let ReturnField1 = Colmn1
End FunctionFunction ReturnField2()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' CPF.Let ReturnField2 = Colmn2
End FunctionFunction ReturnField3()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' Nome.Let ReturnField3 = Colmn3
End FunctionFunction ReturnField4()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' funcao.Let ReturnField4 = Colmn4
End FunctionFunction ReturnField5()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' nivel_profis.Let ReturnField5 = Colmn5
End FunctionFunction ReturnField6()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' Disciplina.Let ReturnField6 = Colmn6
End FunctionFunction ReturnField7()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' data_admissao.Let ReturnField7 = Colmn7
End FunctionFunction ReturnField8()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' data_demissao.Let ReturnField8 = Colmn8
End FunctionFunction ReturnField9()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' lotacao.Let ReturnField9 = Colmn9
End FunctionFunction ReturnField10()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.' razao_soci.Let ReturnField10 = Colmn10
End FunctionFunction ReturnField11()
' Author: Date: Contact:' André Bernardes 16/10/2008 12:05 bernardess@gmail.com' Return value field.Let ReturnField11 = Colmn11
End FunctionFunction ErrorShow()
' Author: Date: Contact:' André Bernardes 02/10/2008 10:57 bernardess@gmail.com' Mostra o erro que ocorreu.' Erro 55 - Arquivo já está aberto.' Erro 3065 - Não é possível executar uma consulta seleção.' Caso haja erro.If Err.Number <> 0 ThenMsgBox "ATENÇÃO!" &; Chr(13) &; Chr(10) &; Chr(13) &; Chr(10) &; _"Nº: " &; Err.Number &; Chr(13) &; Chr(10) &; _"Description: " &; Err.Description &; Chr(13) &; Chr(10) &; _"Source: " &; Err.Source &; Chr(13) &; Chr(10) &; _"File|H Context: " &; Err.HelpFile &; " | " &; Err.HelpContext &; Chr(13) &; Chr(10), vbCritical, "Erro:", Err.HelpFile, Err.HelpContextEnd If
End Function
Adicionalmente é importante dizer que para abrir um procedimento armazenado dentro de ActiveX Data Objects (ADO), você deve primeiro abrir um preenchimento de objeto de conexão, em seguida, um objeto de comando, o conjunto Parameters com um parâmetro na coleção para cada parâmetro na consulta e, em seguida, use o método Command.Execute() para abrir o Recordset ADO.
Opcionalmente pode usar o método Parameters.Refresh para preencher a coleção de parâmetros para o procedimento armazenado. Além disso, se o procedimento armazenado retor saída ou retornar parâmetros, você precisa fechar o conjunto de registros antes de verificar o valor dos parâmetros de saída.
Isso é demonstrado nos trechos de código abaixo que exclui (se ele já existir) e, em seguida, cria um procedimento armazenado, sp_adoTest, em um SQL Server que tem de entrada, saída e parâmetros de retorno, bem como retornar um conjunto de registros.
Este artigo demonstra como executar esta operação usando o VBA / VBScript:
Dim Conn1 As ADODB.ConnectionDim Cmd1 As ADODB.CommandDim Rs1 As ADODB.RecordsetDim strTmp As StringDim Connect As StringDim Drop As StringDim Create As StringDim sp as stringDim i As IntegerDim l As LongLet sConnect= "driver={sql server};" &; _"server=server_name;" &; _"Database=pubs;UID=uder_id;PWD=password;"Let sCreate = "create proc sp_AdoTest( @InParam int, " &; _"@OutParam int OUTPUT ) " &; _"as " &; _"select @OutParam = @InParam + 10 " &; _"SELECT * FROM Authors WHERE "&; _"State <> 'CA' " &; _"return @OutParam +10"
Let sDrop= "if exists " &; _"(select * from sysobjects where " &; _"id = object_id('dbo.sp_AdoTest') and " &; _"sysstat &; 0xf = 4)" &; _"drop procedure dbo.sp_AdoTest"Let sSP = "sp_Adotest"' Establish connection.Set Conn1 = New ADODB.ConnectionConn1.ConnectionString = sConnectConn1.Open' Drop procedure, if it exists &; recreate it.Set Rs1 = Conn1.Execute(sDrop, l, adCmdText)Set Rs1 = NothingSet Rs1 = Conn1.Execute(sCreate, l, adCmdText)Set Rs1 = Nothing' Open recordset.Set Cmd1 = New ADODB.CommandCmd1.ActiveConnection = Conn1Cmd1.CommandText = "sp_AdoTest"Cmd1.CommandType = adCmdStoredProcCmd1.Parameters.RefreshCmd1.Parameters(1).Value = 10Set Rs1 = Cmd1.Execute()' Process results from recordset, then close it.RS1.CloseSet Rs1 = Nothing' Get parameters (assumes you have a list box named List1).Debug.print vbTab &; "RetVal Param = " &; Cmd1.Parameters(0).ValueDebug.print vbTab &; "Input Param = " &; Cmd1.Parameters(1).ValueDebug.print vbTab &; "Output Param = " &; Cmd1.Parameters(2).Value
Para usuários do VBScript, você substituiria as instruções Dim com chamadas de CreateObject equivalentes, como: Set conn1 = CreateObject( "ADODB.Connection.1.5" )
Referências: 172403 EXEMPLO: Adovb.exe demonstra como usar o ADO com o Visual Basic
220152 ARQUIVO: Adovc.exe demonstra como usar o ADO com o Visual C++
Tags: Bernardes, Windows, Office, Access, VBA, automation, SP, Stored Procedure, Views, Tables, field, ADO, ActiveX Data Objects, Database, trigger, Get, SQL,
André Luiz Bernardes
A&A® - Work smart, not hard.
Skype: inanyplace
Twitter: @bernardess
Hola André,
ResponderExcluirSimplemente indicar que cando declaras as varibles coma:
Dim i, j As Integer
Dim nTx1, nTx2, nTx3, nTx4, nTx5, nTx6 As String
debes notar que "i" non ficará coma un "Integer", senon un "Variant". O mesmo ocorre con nTx1, nTx2... non serán "Strings" (aínda que ao darlles valores, VBA recoñeceráos coma Variant/String).
Funcionalmente non ten problema (aínda que algo de velocidade se perde no código), pero poderían aparecer con operacións do tipo j=i.
Un saúdo.