Propósito

✔ Programação GLOBAL® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog devem ser tratados como consultoria freelance. Queiram contatar-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.

.: Vitrine

Carregando artigos...

Views

Mostrando postagens com marcador field. Mostrar todas as postagens
Mostrando postagens com marcador field. Mostrar todas as postagens

Excel Tips - Populando Combo Box - Multi-Column




Crie um Combobox
Os usuários da versões Excel 2010 e Excel 2007 podem clicar em Inserir a partir da aba Desenvolvedor, clicando no Combo Box na seção de Controles ActiveX.


Os usuários da versão Excel 2003. Clicarão no ícone do Combo Box na caixa de ferramentas.



Agora desenhe o combo Box na sua planilha:



Adicionando itens no Combobox

Para adicionar itens ao seu combobox, execute os seguintes passos.
1. Adicione o código abaixo na área de código de abertura da sua planilha (Workbook Open event), ou o adicione a outro módulo do seu código.
With Sheet1.ComboBox1
   .AddItem "Paris"
   .AddItem "New York"
   .AddItem "London"
End With

Nota: Use Sheet2 se o seu combobox estiver localizado na sua segunda worksheet.
Resultado:

2. Para conectar o conteúdo do combobox a uma célula, clique com o botão direito do mouse no combobox (certifique-se de estar no modo design) e clique em Propriedades. Preencha E2 como a célula a ser preenchida.


Como popular um combobox nos formulários?

Nível da implementação: Intermediário.
Versão em que foi testada: 2000 - 2013.
Descrição: Um combobox é disponibilizado com 10 linhas e treze colunas de informação.

Segue o 1º exemplo:

Option Explicit

Private Sub UserForm_activate()
Dim MyList(10, 10) 'Definindo como array.
' O combobox neste exemplo contém 3 colunas - Implemente quantas colunas desejar

With ComboBox1
.ColumnCount = 3
.ColumnWidths = 75
.Width = 220
.Height = 15
.ListRows = 6
End With

' Definindo tanto a lista como o local de onde obter os dados (Colunas A, D, G)
With ActiveSheet
' MyList (Linha{0 to 9}, Coluna{primeira}) = (Coluna A neste exemplo) ' Não se esqueça de continuar acrescentando para LINHA e COLUNA ' iniciando do zero Não de um MyList(0, 0) = .Range("A1")
MyList(1, 0) = .Range("A2")
MyList(2, 0) = .Range("A3")
MyList(3, 0) = .Range("A4")
MyList(4, 0) = .Range("A5")
MyList(5, 0) = .Range("A6")
MyList(6, 0) = .Range("A7")
MyList(7, 0) = .Range("A8")
MyList(8, 0) = .Range("A9")
MyList(9, 0) = .Range("A10")
' MyList (Linha {0 to 9}, Coluna{segunda}) = (Coluna D neste exemplo) MyList(0, 1) = .Range("D1")
MyList(1, 1) = .Range("D2")
MyList(2, 1) = .Range("D3")
MyList(3, 1) = .Range("D4")
MyList(4, 1) = .Range("D5")
MyList(5, 1) = .Range("D6")
MyList(6, 1) = .Range("D7")
MyList(7, 1) = .Range("D8")
MyList(8, 1) = .Range("D9")
MyList(9, 1) = .Range("D10")
' MyList (Linha {0 to 9}, Coluna {Terceira}) = (Coluna G neste exemplo) MyList(0, 2) = .Range("G1")
MyList(1, 2) = .Range("G2")
MyList(2, 2) = .Range("G3")
MyList(3, 2) = .Range("G4")
MyList(4, 2) = .Range("G5")
MyList(5, 2) = .Range("G6")
MyList(6, 2) = .Range("G7")
MyList(7, 2) = .Range("G8")
MyList(8, 2) = .Range("G9")
MyList(9, 2) = .Range("G10")
End With

' Agora populamos o Combobox
ComboBox1.List() = MyList
End Sub 

Como usar:
Abra uma planilha MS Excel
Selecione Editor Visual Basic (Tools/Macro/Visual Basic Editor)
Na janela do editor VBA (VBE window), selecione Insert/UserForm
Selecione ComboBox a partir da caixa de ferramentas (toolbox), cole-o no Formulário
Clique o botão direito do mouse no formulário
Selecione Inserir código
Então copie e cole o código acima
Testando o código:
Digite alguns dados nas colunas A, D e G na planilha
Exiba o formulário novamente, agora verá as três colunas preenchidas no Combobox

Segue o 2º exemplo:

Populando o controle:

Option Explicit 
Private Sub UserForm_Initialize() 
     
    With Me.ComboBox1 
        .AddItem "Item 1" 
        .AddItem "Item 2" 
    End With 
     
End Sub 

Populando a partir da seleção de um range na planilha:

Option Explicit 
Private Sub CommandButton1_Click() 
     
    With Sheet1 'code name
        .Range("A1") = Me.ComboBox1.Value 
    End With 
     
End Sub 


Outro:

Private Sub UserForm_Initialize()
    With Worksheets("Sheet1")
        ComboBox1.List = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
    End With
End Sub

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...


TagsVBA, Office, Application, Automation, field,  Plan, planilhas, column, Excel, Multi-Collumn, populando, combobox, 


VBA Access - Limpe todos os Espaços dos Campos Texto - Trim all text fields in a MS Access database



Recentemente tive a necessidade de aparar campos texto numa tabela em um dos bancos de dados que precisei fazer manutenção.

Ao efetuar o loop através de cada tabela no banco de dados, eliminei todos os espaços desnecessários dos campos de texto. Agora todas as consultas de comparação funcionarão.

Esta versão também funcionará quando houver campos que não forem texto.


Sub TrimAllTextFieldsAllTables()
  Dim db As DAO.Database
  Dim tbls As DAO.TableDefs

  Dim tbl As DAO.TableDef
  Dim thisTable As DAO.TableDef
  Dim SQLString As String
  Dim flds As DAO.Fields
  Dim fld As DAO.Field
  Dim hasText As Boolean
  
  Set db = CurrentDb
  Set tbls = db.TableDefs
  
  ' loop through each appropriate table (i.e. no linked or system tables)
  For Each tbl In tbls
    hasText = False 'added
    If tbl.Attributes = 0 Then
      Set thisTable = tbl
      ' grab all fields
      Set flds = thisTable.Fields
  
      SQLString = "UPDATE [" & tbl.Name & "] SET "
  
      ' if field is text, create SQL string to trim it
      For Each fld In flds
        If fld.Type = dbText Then
          hasText = True 'added
          SQLString = SQLString & _
                 "[" & fld.Name & "] = Trim([" & fld.Name & "]),"
        End If
      Next fld
  
      SQLString = Left(SQLString, Len(SQLString) - 1) & ";"
      If hasText Then 'added
        Debug.Print SQLString
        ' execute update statement on table
        db.Execute SQLString, dbFailOnError
      End If 'added
    End If
  Next tbl
  
End Sub


Tags: VBA, Access, field, text, campo, texto, trim, 


VBA Access - Adicionando campo em tabela pré-existente - VBA Access: How to Add Fields to Existing Tables for BI and Data Automation

Termo de Responsabilidade

Inserir campos em tabelas que já existem são necessidades freqüentes quando efetuamos manutenções em bancos de dados. Mas qual é o código mais apropriado para isso? Segue:

Function Vai()
    ' Author:                     Date:               Contact:
    ' André Bernardes             06/03/2012 16:32    https://www.linkedin.com/in/andreluizbernardes/
    ' Application: MedicalPanelAnalyseBrazil®
    ' Source Code:
    ' Listening:
    ' Cria campo dentro de uma tabela.
    
    Call AddFieldToTable ("PMedico", "TimeStamp", dbDate, , , Now())
End Function

Function AddFieldToTable (ByVal TblName As String, FldName As String, FldType As Integer, Optional FldPos As Integer,Optional FldSize, Optional DefaultValue, Optional FldDes, Optional IsAutoNumber) As Boolean

    ' Author:                     Date:               Contact:
    ' André Bernardes             06/03/2012 16:32    https://www.linkedin.com/in/andreluizbernardes/
    ' Application: MedicalPanelAnalyseBrazil®
    ' Source Code:
    ' Listening:
    ' Cria campo dentro de uma tabela.
    
    Dim Db As Database
    Dim DbPath As Variant
    Dim Td As TableDef
    Dim Fd As Field
    Dim p As Property

    On Error Resume Next

    'get back end path of linked table
    DbPath = DLookup("Database", "MSysObjects", "Name='" & TblName & "' And Type=6")
    If IsNull(DbPath) Then
        Set Db = CurrentDb 'if local table
    Else
        Set Db = OpenDatabase(DbPath) 'if linked table
        If Err <> 0 Then
            'failed to open back end database
            Exit Function
        End If
        'in case back end has different table name than front end
        TblName = DLookup("ForeignName", "MSysObjects", "Name='" & TblName & "' And Type=6")
    End If

    'get table
    Set Td = Db.TableDefs(TblName)
    If Err <> 0 Then
        'failed to get table
        GoTo Done
    End If

    'if IsAutoNumber, then use the correct field Type
    If Not IsMissing(IsAutoNumber) Then
        If IsAutoNumber Then
            FldType = dbLong
        End If
    End If

    'add field and properties
    With Td
        'create field
        If FldType = dbText And Not IsMissing(FldSize) Then
            Set Fd = .CreateField(FldName, FldType, FldSize)
        Else
            Set Fd = .CreateField(FldName, FldType)
        End If
        
        'position (0 is first position)
        If Not IsMissing(FldPos) Then
            Dim Num As Integer
            For Num = 0 To FldPos - 1
                Td.Fields(Num).OrdinalPosition = Num
            Next
            For Num = FldPos To .Fields.Count - 1
                Td.Fields(Num).OrdinalPosition = Num + 1
            Next
        End If
        
        'if IsAutoNumber
        If Not IsMissing(IsAutoNumber) Then
            If IsAutoNumber Then
                Fd.Attributes = 17
            End If
        End If
        
        'add field to table
        .Fields.Append Fd
        If Err <> 0 Then
            'failed to add field - probably already exists
            GoTo Done
        End If
        
        'default
        If Not IsMissing(DefaultValue) Then
            .Fields(FldName).DefaultValue = DefaultValue
        End If
        
        'add description property
        If Not IsMissing(FldDes) Then
             Set p = .Fields(FldName).CreateProperty("Description", dbText, FldDes)
             .Fields(FldName).Properties.Append p
        End If
        
        'other properties according to personal preference
        If FldType = dbText Then
            .Fields(FldName).AllowZeroLength = True
        End If
        
        
    End With

    AddFieldToTable = True 'defaults to false if it fails to get here
    
'clean up
Done:
    Set Fd = Nothing
    Set Td = Nothing
    If Not Db Is Nothing Then Db.Close
    Set Db = Nothing
End Function

Sub CallAddField()
    ' Author:                     Date:               Contact:
    ' André Bernardes             06/03/2012 16:32   https://www.linkedin.com/in/andreluizbernardes/
    ' Application: MedicalPanelAnalyseBrazil®
    ' Source Code:
    ' Listening:
    ' Cria campo dentro de uma tabela.
    
    Dim Result As Boolean

    'sample call:
    Result = AddFieldToTable("Table1", "NewFieldName", dbText, 2, 10, , "sample description")

    Debug.Print Result

    'Possible values for FldType parameter:
    ' dbBigInt (Decimal)
    ' dbBinary
    ' dbBoolean (Yes/No)
    ' dbByte
    ' dbCurrency
    ' dbDate
    ' dbDouble
    ' dbGUID (Replication ID)
    ' dbInteger
    ' dbLong (Long Integer)
    ' dbLongBinary (OLE Object)
    ' dbMemo
    ' dbSingle
    ' dbText (specify size, or length of text)
    ' dbVarBinary (OLE Object)

    'FldPos parameter is the ordinal position, 0 being position 1,
    '  but it works sporadically - I don't know why.
    'For optional IsAutoNumber parameter, use True or False, or leave blank.
End Sub

References:

Tags: VBA, Access, Add, field, table, campo, tabela


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 &lt;= 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 &lt;&gt; 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
diHITT - Notícias