Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

Views

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ências172403  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

VBA ACCESS - Campo Auto Numérico - Creating an AutoNumber field from code - VBA, DAO, DDL e SQL

Criar campos de autonumeração em tabelas usando VBA, DAO, DDL e SQL


Creating an AutoNumber field from code
Append a record using vba where there is an auto number field
Auto Increment
Auto-number text field
AutoNumber and INSERT INTO VBA Issue
Autonumber field
Autonumber value of last inserted row
Autonumber vba
Autonumeração complexa
Create an Autonumber Field with VBA For a MS Access
Creating an AutoNumber field from code
Creation of an autonumber with VBA access
Microsoft Access Autonumber Increments
Setting the value of an Autonumber field
VBA - How to create user-defined auto-increment data type


Existem 2 caminhos para acrescentarmos um campo cujo o conteúdo seja autonumerado:

Um dos modos é fazê-lo através do comando SQL DDL Create Table, e o outro é o modo como abordaremos neste artigo usando VBA e DAO para adicionar um campo em uma tabela pré-existente.

A função abaixo, desenvolvida por Dev Ashish, serve para efetuar tal ação em qualquer tabela na qual tenhamos a necessidade de inserirmos um campo numerado.

Function fCreateAutoNumberField (ByVal strTableName As String, ByVal strFieldName As String) As Boolean
    Dim db As DAO.Database
    Dim fld As DAO.Field
    Dim tdf As DAO.TableDef

    On Error GoTo ErrHandler

    Set db = Application.CurrentDb
    Set tdf = db.TableDefs(strTableName)
    
    '   Primeiro criamos um campo com o tipo = Long Integer
    Set fld = tdf.CreateField(strFieldName, dbLong)
    
    With fld
        '   Adicionamos o dbAutoIncrField para efetuar chamadas ao Jet que sozinho efetuará a autonumeração do campo
        Let .Attributes = .Attributes Or dbAutoIncrField
    End With
    
    With tdf.Fields
        .Append fld
        .Refresh
    End With
    
    Let fCreateAutoNumberField = True
    
ExitHere:
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
    Exit Function
ErrHandler:
    Let fCreateAutoNumberField = False
    
    With Err
        MsgBox "Erro: " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, "CreateAutonumberField"
    End With

    Resume ExitHere
End Function


Ei, Ok! tudo bom, tudo legal, mas e quanto a primeira opção? Não chorem, coloquei-a mais abaixo:

Para criar uma tabela com um campo com AutoNumeração e PrimaryKey, além de um campo chamado MyText com o tipo TEXTO e comprimento de 10, insira a instrução a seguir na janela de consulta de definição de dados e, em seguida, executar a consulta.

CREATE TABLE Table1 _
(Id COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, _
MyText TEXT (10))



Tag: Bernardes, MS, Microsoft, VBA, Office, Access, Table, query, SQL, VBA, DAO, autonumber, increment, Function, Dev Ashish, counter, create, key, code


André Luiz Bernardes
A&A® - Work smart, not hard.



ENVIE-ME SUA PLANILHA - E FAÇO A SUA Tabela Dinâmica - Promoção de Novembro/2011



QUE TAL MELHORAR A PERFORMANCE E A APARÊNCIA DAS SUAS PLANILHAS?

Precisa regularmente construir relatórios com layouts diferentes e perde muito tempo com isto?

Seus arquivos texto têm dezenas, centenas de milhares de linhas e você fica copiando para outras planilhas para poder caber?

Precisa consolidar informações de fontes diferentes?

Tem arquivos imensos, com dezenas de megabytes onde coloca dados extraídos de ERP e sistemas de gestão diversos?

Percebe que o filtro do MS Excel não está mais te atendendo?

Gasta mais tempo montando o relatório do que o analisando?

ACRESCENTE TABELAS DINÂMICAS!

Traga dados de fora do Excel

Importando dados de arquivos: Texto, Access, Dbase, Oracle, SQL Server, CSV e outros arquivos de Excel

Usando o MS Query para fazer consultas avançadas

Trazendo dados para suas planilhas sem a necessidade da tabela dinâmica

Tags: Bernardes, MS, Microsoft, Office, MS Excel, Excel, Planilhas, Dados, Data, workshet, workbook, Pivot Table, Tabela Dinâmica, Gráfico Dinâmico, Dynamic Chart, Texto, Access, Dbase, Oracle, SQL Server, CSV, query
 
 
André Luiz Bernardes
A&A® - Work smart, not hard.



Promoção de Novembro/2011 - Tabela Dinâmica - Pivot Table.



QUE TAL MELHORAR A PERFORMANCE E A APARÊNCIA DAS SUAS PLANILHAS?


Precisa regularmente construir relatórios com layouts diferentes e perde muito tempo com isto?

 

Seus arquivos texto têm dezenas, centenas de milhares de linhas e você fica copiando para outras planilhas para poder caber?

 

Precisa consolidar informações de fontes diferentes?

 

Tem arquivos imensos, com dezenas de megabytes onde coloca dados extraídos de ERP e sistemas de gestão diversos?

 

Percebe que o filtro do MS Excel não está mais te atendendo?


Gasta mais tempo montando o relatório do que o analisando?


ACRESCENTE TABELAS DINÂMICAS!

Traga dados de fora do Excel

    • Importando dados de arquivos: Texto, Access, Dbase, Oracle, SQL Server, CSV e outros arquivos de Excel;
    • Usando o MS Query para fazer consultas avançadas
    • Trazendo dados para suas planilhas sem a necessidade da tabela dinâmica

Tags: Bernardes, MS, Microsoft, Office, MS Excel, Excel, Planilhas, Dados, Data, workshet, workbook, Pivot Table, Tabela Dinâmica, Gráfico Dinâmico, Dynamic Chart, Texto, Access, Dbase, Oracle, SQL Server, CSV, query, 
 
André Luiz Bernardes
A&A® - Work smart, not hard.



VBA Access - Exportando query ou tabela para arquivo texto com tabulação.

Exportar o conteúdo de tabelas, e o resultado de queries para arquivos texto delimitados por tabulação, não é algo tão difícil de aparecer como nossa necessidade.

Converting Pipe Delimited Text File To Tab Delimited
Create queries and export them to different tab delimited text
Export Access Query to a pipe delimited .csv file
Export Query result to txt file tab delimited 
Export query results to text file - not delimited
Export query to tab delimited text file
Export query to tab delimited text file
Exporting Data from Access with VBA Code
Microsoft: Access Modules (VBA Coding)
TransferText Macro Action
Truncation of Text on Export to .txt file
VBA + TransferText + SpecificationName (Access 2007) 
Visual Basic :: Export An Access Table As A Tab Delimited Text
table from .ADP to tab delimited text file 
 
Ainda bem que o MS Access facilita o nosso trabalho.

Observe os passos abaixo:





Posicione o mouse sobre a tabela que deseja exportar e pressione o botão direito.



A interface abaixo o conduzirá para os próximos passos. Informe primeiro o local onde o arquivo será gravado e pressione OK.



Agora ficou fácil!

Siga o passo-a-passo demonstrado abaixo. Certifique-se de escolher toda as mesmas versões demonstradas.





A fase abaixo será muito útil no futuro, pois gravaremos o modo de exportar como uma especificação, a qual poderá ser utilizada com código VBA a posteriori. 


CLIQUE EM AVANÇADO E SALVE-A.



Confirme o local para onde o conteúdo será exportado como arquivo texto.



Lembre-se que a especificação salva anteriormente poderá ser utilizada em conjunto com o código VBA. Como?

Crie um formulário

Crie um botão neste mesmo formulário

Insira o código abaixo dentro da ação do seu botão:

Function Export2Txt()
    Dim nPath As String
    
    Let nPath = "C:\Bernardes\"

    DoCmd.TransferText _
    acExportDelim, _
    "specExport", _
    acExportDelim, _
    , _
    "tbl_Factive", _
    nPath & "tbl_Export.txt", True
End Function


Tags: André Luiz Bernardes, VBA, Office, Microsoft, MS, Access, MS Access 2007, Export, exportação, file, Texto, text, TAB, tabulação, tabela, query, delimitado, delimited, TransferText, SpecificationName

André Luiz Bernardes
A&A® - Work smart, not hard.

LinkWithinBrazilVBAAccessSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine