MS Access – VBA - Recuperando valores de um Stored Procedure.

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_add

nome do campo   | Tipo de dados  | Conteúdo

nThing                   | 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 Variant

Public Colmn1 As Variant

Public Colmn2 As Variant

Public Colmn3 As Variant

Public Colmn4 As Variant

Public Colmn5 As Variant

Public Colmn6 As Variant

Public Colmn7 As Variant

Public Colmn8 As Variant

Public Colmn9 As Variant

Public Colmn10 As Variant

Public Colmn11 As Variant

Option Compare Database

Function 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_trabalho

On Error GoTo Err_Execute ' Prepara para análise de erro.

' Prepare variables.

Dim db As Database

Dim StrConection As String

Dim StrConection1 As String

Dim i, j As Integer

Dim flag As Boolean

Dim nTx1, nTx2, nTx3, nTx4, nTx5, nTx6 As String

' Busca parâmetros de conexão em formulário.

Let nTx1 = [Form_frm_sys_SybaseImport].CxStoredProcedure.Value

Let nTx2 = [Form_frm_sys_SybaseImport].CxDSN.Value

Let nTx3 = [Form_frm_sys_SybaseImport].CxServer.Value

Let nTx4 = [Form_frm_sys_SybaseImport].CxDatabase.Value

Let nTx5 = [Form_frm_sys_SybaseImport].CxUser_ID.Value

Let nTx6 = [Form_frm_sys_SybaseImport].CxPassword.Value

Let 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 Procedure

Set 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 Then

Let j = 1

While j <= 11

'Debug.Print rs(j).Name

Let j = j + 1

Wend

Let 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) ' Registro

Let Colmn2 = Trim(rs(2).Value) ' CPF

Let Colmn3 = Trim(rs(3).Value) ' Nome

Let Colmn4 = Trim(rs(4).Value) ' funcao

Let Colmn5 = Trim(rs(5).Value) ' nivel_profis

Let Colmn6 = Trim(rs(6).Value) ' Disciplina

Let Colmn7 = Trim(rs(7).Value) ' data_admissao

Let Colmn8 = Trim(rs(8).Value) ' data_demissao

Let Colmn9 = Trim(rs(9).Value) ' lotacao

Let Colmn10 = Trim(rs(10).Value) ' razao_soci

Let Colmn11 = Trim(rs(11).Value) ' local_trabalho

' Atualiza a tabela de Recursos Humanos.

DoCmd.SetWarnings (False)

DoCmd.OpenQuery "qry_sys_SetPeople", acViewNormal, acAdd

DoCmd.SetWarnings (True)

' Avança uma linha no recordset.

rs.MoveNext

' Variável meramente informativa.

Let i = i + 1

Loop

' Fecha Recordset e Base de dados.

rs.Close

Set db = Nothing

' Limpa as variáveis públicas.

Let Colmn0 = Null

Let Colmn1 = Null

Let Colmn2 = Null

Let Colmn3 = Null

Let Colmn4 = Null

Let Colmn5 = Null

Let Colmn6 = Null

Let Colmn7 = Null

Let Colmn8 = Null

Let Colmn9 = Null

Let 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 Function

Function ReturnField0()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

'

Let ReturnField0 = Colmn0

End Function

Function ReturnField1()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' Registro.

Let ReturnField1 = Colmn1

End Function

Function ReturnField2()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' CPF.

Let ReturnField2 = Colmn2

End Function

Function ReturnField3()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' Nome.

Let ReturnField3 = Colmn3

End Function

Function ReturnField4()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' funcao.

Let ReturnField4 = Colmn4

End Function

Function ReturnField5()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' nivel_profis.

Let ReturnField5 = Colmn5

End Function

Function ReturnField6()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' Disciplina.

Let ReturnField6 = Colmn6

End Function

Function ReturnField7()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' data_admissao.

Let ReturnField7 = Colmn7

End Function

Function ReturnField8()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' data_demissao.

Let ReturnField8 = Colmn8

End Function

Function ReturnField9()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' lotacao.

Let ReturnField9 = Colmn9

End Function

Function ReturnField10()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

' razao_soci.

Let ReturnField10 = Colmn10

End Function

Function ReturnField11()

' Author: Date: Contact:

' André Bernardes 16/10/2008 12:05 bernardess@gmail.com

' Return value field.

Let ReturnField11 = Colmn11

End Function

Function 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 Then

MsgBox "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.HelpContext

End 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.Connection

Dim Cmd1 As ADODB.Command

Dim Rs1 As ADODB.Recordset

Dim strTmp As String

Dim Connect As String

Dim Drop As String

Dim Create As String

Dim sp as string

Dim i As Integer

Dim l As Long

Let 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.Connection

Conn1.ConnectionString = sConnect

Conn1.Open

' Drop procedure, if it exists &; recreate it.

Set Rs1 = Conn1.Execute(sDrop, l, adCmdText)

Set Rs1 = Nothing

Set Rs1 = Conn1.Execute(sCreate, l, adCmdText)

Set Rs1 = Nothing

' Open recordset.

Set Cmd1 = New ADODB.Command

Cmd1.ActiveConnection = Conn1

Cmd1.CommandText = "sp_AdoTest"

Cmd1.CommandType = adCmdStoredProc

Cmd1.Parameters.Refresh

Cmd1.Parameters(1).Value = 10

Set Rs1 = Cmd1.Execute()

' Process results from recordset, then close it.

RS1.Close

Set Rs1 = Nothing

' Get parameters (assumes you have a list box named List1).

Debug.print vbTab &; "RetVal Param = " &; Cmd1.Parameters(0).Value

Debug.print vbTab &; "Input  Param = " &; Cmd1.Parameters(1).Value

Debug.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.

bernardess@gmail.com

 Skype: inanyplace

Twitter: @bernardess

LinkedIn
Plaxo

VBA Excel - Abrindo e fechando o CD-ROM - Open and close the CD-ROM tray using VBA in Microsoft Excel

Já sei, já sei. Muitos perguntarão: 


_ Prá que aprender a abrir a gaveta do CD-ROM?


Perceba que não estarão apenas aprendendo 'a abrir a gaveta do CD-ROM', antes estará aprendendo a manipular periféricos em uma máquina, utilizando uma API do Windows.


Declare Sub mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, _ ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, _ ByVal hwndCallback As Long)


Sub OpenCDTray()
    mciSendStringA "Set CDAudio Door Open", 0, 0, 0
End Sub


Sub CloseCDTray()
    mciSendStringA "Set CDAudio Door Closed", 0, 0, 0
End Sub







Tags: Bernardes, MS, Microsoft, Windows, Office, VBA, Excel, CD, CD-ROM, CDROM, mciSendStringA,winmm.dll, API, DLL, Lib

André Luiz Bernardes

A&A® - Work smart, not hard.

VBA Blogs

  

bernardes@.com

VBA Tip - Como utilizar a memória RAM - Using Clipboard, RAM Memory

Pois é, 

Todos usamos muito a famosa funcionalidade CTRL + C e CTRL + V. Sim o copy/paste é muito útil e porque não dizer, indispensável. Mas como podemos implementar essa funcionalidade dentro das nossas aplicações MS Office?

How to Use the Office Clipboard in VBA

How to Copy From the Clipboard in Excel Using VBA

How to Cut & Paste From the Clipboard in Excel VBA

Em que momento desejarei utilizar essa funcionalidade nas minhas aplicações? Através do VBA, é possível, por exemplo,  recuperarmos quaisquer informações que estiverem na Área de Transferência, utilizando-as em nossas aplicações, ou podemos fazer o caminho inverso e disponibilizar o resultado de certo processamento para a área de transferência.

Sub PutInRAM ()     Dim nOBJ As MSForms.DataObject     Set dtOBJ = New MSForms.DataObject          Dim n As String

Let n = "Bernardes"

    dtOBJ.SetText s
     dtOBJ.PutInClipboard 

End Sub

Sub GetInRam ()     Dim dtOBJ As MSForms.DataObject     Dim n As String          Set dtOBJ = New MSForms.DataObject          dtOBJ.GetFromClipboard          Let n = dtOBJ.GetText          MsgBox n 

End Sub

' Compatibilizando as versões do MS Office

#If VBA7 Then

    Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long

    Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

    Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

#Else

    Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

    Public Declare Function EmptyClipboard Lib "user32" () As Long

    Public Declare Function CloseClipboard Lib "user32" () As Long

#End If

Sub EmptyInRAM()

    OpenClipboard (0&)

    EmptyClipboard

    CloseClipboard

End Sub

Referência: Ambiente Office

                    CPerson

                    Copy and Paste Multiple Items by Using the Office Clipboard

Tags: Bernardes, MS, Microsoft, Office, VBA, TIP, Clipboard, RAM, memory, memória, RAM, copy/paste

André Luiz Bernardes

A&A® - Work smart, not hard.

bernardess@gmail.com

Skype: inanyplace 

LinkedIn
Plaxo