VBA Tips - ADO - Criando Tabela

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Exemplo de criação de uma tabela chamada tblARPDetail. Requer referência a ADOx.

Public Sub ADOXCreateDetailTable()

  

    Dim cat As New ADOX.Catalog

  

    Dim tbl As ADOX.table

    

    Set cat.ActiveConnection = CurrentProject.Connection

    

    On Error Resume Next

    

    Set tbl = cat.Tables("tblARPDetail")

    

    If tbl Is Nothing Then

        

    Else

    

        cat.Tables.Delete "tblARPDetail"

        

        Set tbl = Nothing

    End If

    

    Set tbl = New ADOX.table

        

    cat.Tables.Delete "tblARPDetail"

    

    tbl.Name = "tblARPDetail"

     

        With tbl.Columns

            

            .Append "dtmPayableDate", adDate

            

            .Append "strPrefix", adVarWChar, 3

            

            .Append "strCheckNumber", adVarWChar, 13

            

            .Append "curAmount", adCurrency

            

            .Append "strLoanAccount", adVarWChar, 12

            

            .Append "strShortName", adWChar, 40

            

            .Append "strCity", adVarWChar, 40

            

            .Append "strState", adVarWChar, 2

            

            .Append "strZip", adVarWChar, 12

            

            .Append "strName", adVarWChar, 40

            

            .Append "strAddress1", adVarWChar, 40

            

            .Append "strAddress2", adVarWChar, 40

            

            .Append "strAddress3", adVarWChar, 40

            

            .Append "strAddress4", adVarWChar, 40

            

            .Append "strSSN", adVarWChar, 12

            

            .Append "strInternalNumber", adVarWChar, 12

            

            .Append "strLoanNumber", adVarWChar, 12

            

            .Append "strDatabase", adVarWChar

            

            .Append "strLoanType", adVarWChar, 4

            

            .Append "strPayeeNumber", adVarWChar

            

            .Append "bolForeign", adBoolean

            

            .Append "bolEligible", adBoolean

            

            .Append "bolLump", adBoolean

            

            .Append "bolDueDiligence", adBoolean

            

            With !dtmPayableDate

              Set .ParentCatalog = cat

              .Properties("Description") = "Payable Date"

            End With

            

            With !strPrefix

              Set .ParentCatalog = cat

              .Properties("Description") = "Check Prefix"

              .Properties("AllowZeroLength") = True

            End With

            

            With !strCheckNumber

              Set .ParentCatalog = cat

              .Properties("Description") = "Check Number"

            End With

            

            With !curAmount

              Set .ParentCatalog = cat

              .Properties("Description") = "Check Face Amount"

            End With

            

            With !strLoanAccount

              Set .ParentCatalog = cat

              .Properties("Description") = "Hogan Account"

            End With

            

            With !strShortName

              Set .ParentCatalog = cat

              .Properties("Description") = "BondMaster Loan Short Name"

            End With

            

            With !strCity

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee City"

            End With

            

            With !strState

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee State"

            End With

            

            With !strZip

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee Zip"

            End With

            

            With !strName

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee Name"

            End With

            

            With !strAddress1

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee Address Line 1"

            End With

            

            With !strAddress2

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee Address Line 2"

            End With

            

            With !strAddress3

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee Address Line 3"

            End With

            

            With !strAddress4

              Set .ParentCatalog = cat

              .Properties("allowzerolength") = True

            End With

            

            With !strSSN

              Set .ParentCatalog = cat

              .Properties("Description") = "Payee SSN"

            End With

            

            With !strLoanNumber

              Set .ParentCatalog = cat

              .Properties("Description") = "BondMaster Internal Loan Number"

            End With

            

            With !strDatabase

              Set .ParentCatalog = cat

              .Properties("Description") = "BondMaster Database"

            End With

            

            With !strLoanType

              Set .ParentCatalog = cat

              .Properties("Description") = "BondMaster Loan Type (Corp = 5 and Muni = 2)"

            End With

            

            With !strPayeeNumber

              Set .ParentCatalog = cat

              .Properties("Description") = "BondMaster Payee Number"

            End With

            

          End With

          

    cat.Tables.Append tbl

        

    Set tbl = Nothing

    Set cat = Nothing

    

End Sub

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

Tags: VBA, Tips, ADO, ADOX

VBA Tips - Exemplo da propriedade ActiveConnection de catálogo no Código ADOX

|Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

O que é o fenômeno chamado BIG DATA?

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba  3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Configure a propriedade ActiveConnection como uma conexão válida e abra o catálogo. Torne possível acessar os objetos de esquema contidos em um catálogo aberto.

' BeginOpenConnectionVB 

Sub OpenConnection() 

 On Error GoTo OpenConnectionError 

 Dim cnn As New ADODB.Connection 

 Dim cat As New ADOX.Catalog 

 cnn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _ 

 "Data Source= 'c:\Program Files\Microsoft Office\" & _ 

 "Office\Samples\Northwind.mdb';" 

 Set cat.ActiveConnection = cnn 

 Debug.Print cat.Tables(0).Type 

 'Clean up 

 cnn.Close 

 Set cat = Nothing 

 Set cnn = Nothing 

 Exit Sub 

OpenConnectionError: 

 Set cat = Nothing 

 If Not cnn Is Nothing Then 

 If cnn.State = adStateOpen Then cnn.Close 

 End If 

 Set cnn = Nothing 

 If Err <> 0 Then 

 MsgBox Err.Source & "-->" & Err.Description, , "Error" 

 End If 

End Sub 

' EndOpenConnectionVB 

Configurar a propriedade ActiveConnection como uma sequência de conexão válida também "abrirá" o catálogo.

Sub Main() 

 On Error GoTo OpenConnectionWithStringError 

 Dim cat As New ADOX.Catalog 

 cat.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _ 

 "Data Source='c:\Program Files\Microsoft Office\" & _ 

 "Office\Samples\Northwind.mdb';" 

 Debug.Print cat.Tables(0).Type 

 'Clean up 

 Set cat.ActiveConnection = Nothing 

 Exit Sub 

OpenConnectionWithStringError: 

 Set cat = Nothing 

 If Err <> 0 Then 

 MsgBox Err.Source & "-->" & Err.Description, , "Error" 

 End If 

End Sub 

' EndOpenConnection2VB 

Tags: VBA, ActiveConnection, Tips, ADODB, OLEDB, ADOX, 

VBA Access Advanced - Usando o DDL - Data Definition Language.

| Blog Office VBA | Blog Excel | Blog Access |

Exemplos de Código com o DDL

O SQL padrão é uma sublinguagem utilizada no MS Access para lidar com os dados, tabelas, querys, etc...

Objeto	Tipo
Tabela	1
Query	5
Tabela Conectada	4, 6, or 8
Formulário	-32768
Relatório	-32764
Módulo	-32761

• Data Manipulation Language (DML): O comando SELECT e queries de ação (DELETE, UPDATE, INSERT INTO, ...)

• Data Definition Language (DDL): Comandos que alterem o "schema" (Mudando tabelas, campos, índices, relações, queries, etc.)

Usando o DML para queries, poderemos ler alguns aspectos do "schema" do banco de dados.

Poderá listar os objetos na base de dados Access como abaixo: 

SELECT MSysObjects.Type, MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Name Not Like "~*" ORDER BY MSysObjects.Type, MSysObjects.Name;

Onde Type poderá colocar um dos valores da tabela acima. (Infelizmente, o modo provido pelo DML não é o caminho mais fácil para se ler os nomes dos campos nas tabelas.)

O DDL provê outras características de intervenção como:

• CREATE TABLE para gerar uma nova tabela, especificando os nomes dos campos, tipos, e constraints.

• ALTER TABLE para adicionar uma coluna para a tabela, deletar uma coluna na tabela, ou mudar a tabela como tipo e tamanho da mesma.

• DROP TABLE para deletar uma tabela.

Similarmente, você pode aplicar o comandos CREATE/ALTER/DROP em outras coisas tais como índices, constraints, views e procedures (queries), usuário e grupos (segurança.)

Enquanto o DDL é importante para algumas bases de dados enormes, ele é limitado no uso com o MS Access. Você pode criar um campo Texto, mas não pode configurá-lo com a propriedade Largura Diferente de Zero, ou características similares. Pode criar um campo Yes/No, mas não pode dizer que o dataentry ocorrerá por meio de um text box, ou um check box. Também poderá criar um campo Date/Time, mas não poderá configurar a sua propriedade Format. DDL não pode criar campos Hyperlink, ou campos Attachment.

Poderá executar uma query DDL sob o DAO ou ADO.

Parar DAO, use: dbEngine(0)(0).Execute strSql, dbFailOnError

Parar ADO, use: CurrentProject.Connection.Execute strSql

Algumas características do JET 4 (Access 2000 e superior) são suportados somente sob o ADO.

Uma situação na qual o DDL é realmente utilizável é quanto a mudança do Tipo ou Tamanho dos campos. Você não pode fazer isto com o DAO ou ADOX, utilizar o DDL é a técnica mais prática para estes fins. Obviamente existem outras saídas mais trabalhosas e incoerentes pelo simples fato de serem mais demoradas tanto na implementação quanto na execução.

Abaixo disponibilizo alguns exemplos para que você possa iniciar-se nas técnicas de utilização do DDL.

Índice das Funções	Descrição
CreateTableDDL()	Cria duas tabelas, seus índices e relacionamentos, ilustrando os diferentes tipos de campos suas propriedades configuradas.
CreateFieldDDL()	Ilustra como adicionar um campo para uma tabela.
CreateFieldDDL2()	Adiciona um campo a uma tabela em outra base de dados.
CreateViewDDL()	Cria uma nova query.
DropFieldDDL()	Deleta o campo de uma tabela.
ModifyFieldDDL()	Muda o tipo ou tamanho de um campo. (Este é o mais comum uso do DDL.)
AdjustAutoNum()	Configura o start da AutoNumeração.
DefaultZLS()	Cria um campo que tem por default ser uma stringque não suporta ficar vazia.

Option Compare Database

Option Explicit

Sub CreateTableDDL()

     Dim cmd As New ADODB.Command

     Dim strSql As String

   Let cmd.ActiveConnection = CurrentProject.Connection

   'Cria o "Contractor" na tabela.

   Let strSql = "CREATE TABLE tblDdlContractor " & _           "(ContractorID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, " & _         "Surname TEXT(30) WITH COMP NOT NULL, " & _           "FirstName TEXT(20) WITH COMP, " & _           "Inactive YESNO, " & _         "HourlyFee CURRENCY DEFAULT 0, " & _         "PenaltyRate DOUBLE, " & _           "BirthDate DATE, " & _         "EnteredOn DATE DEFAULT Now(), " & _           "Notes MEMO, " & _         "CONSTRAINT FullName UNIQUE (Surname, FirstName));"       

         "(ContractorID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, " & _

       "Surname TEXT(30) WITH COMP NOT NULL, " & _

       "FirstName TEXT(20) WITH COMP, " & _

           "Inactive YESNO, " & _

       "HourlyFee CURRENCY DEFAULT 0, " & _

       "PenaltyRate DOUBLE, " & _

       "BirthDate DATE, " & _

         "EnteredOn DATE DEFAULT Now(), " & _

         "Notes MEMO, " & _

       "CONSTRAINT FullName UNIQUE (Surname, FirstName));"

   Let cmd.CommandText = strSql       cmd.Execute       Debug.Print "tblDdlContractor criada."         'Cria a tabela de Booking.     

   cmd.Execute

   Debug.Print "tblDdlContractor criada."

   'Cria a tabela de Booking.

   Let strSql = "CREATE TABLE tblDdlBooking " & _           "(BookingID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, " & _         "BookingDate DATE CONSTRAINT BookingDate UNIQUE, " & _         "ContractorID LONG REFERENCES tblDdlContractor (ContractorID) " & _           "ON DELETE SET NULL, " & _         "BookingFee CURRENCY, " & _         "BookingNote TEXT (255) WITH COMP NOT NULL);"       

       "(BookingID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, " & _

       "BookingDate DATE CONSTRAINT BookingDate UNIQUE, " & _

         "ContractorID LONG REFERENCES tblDdlContractor (ContractorID) " & _

       "ON DELETE SET NULL, " & _

         "BookingFee CURRENCY, " & _

       "BookingNote TEXT (255) WITH COMP NOT NULL);"

   Let cmd.CommandText = strSql       cmd.Execute       Debug.Print "tblDdlBooking criado."  End Sub    Sub CreateFieldDDL()      Dim strSql As String     Dim db As DAO.Database           

     cmd.Execute

   Debug.Print "tblDdlBooking criado."

  End Sub

Sub CreateFieldDDL()

      Dim strSql As String

   Dim db As DAO.Database

   Let Set db = CurrentDb()     

   Let strSql = "ALTER TABLE MyTable ADD COLUMN MyNewTextField TEXT (5);"       db.Execute strSql, dbFailOnError       Set db = Nothing       Debug.Print "MyNewTextField adicionado para MyTable"  End Sub    Function CreateFieldDDL2()       Dim strSql As String     Dim db As DAO.Database         Set db = CurrentDb()       

   db.Execute strSql, dbFailOnError

   Set db = Nothing

   Debug.Print "MyNewTextField adicionado para MyTable"

  End Sub

Function CreateFieldDDL2()

       Dim strSql As String

   Dim db As DAO.Database

   Set db = CurrentDb()

   Let strSql = "ALTER TABLE Table IN 'C:\A&A\Junkki.mdb' ADD COLUMN MyNewField TEXT (5);"       db.Execute strSql, dbFailOnError       Set db = Nothing       Debug.Print "MyNewField Adicionado!"  End Function    Function CreateViewDDL()       Dim strSql As String         

   db.Execute strSql, dbFailOnError

   Set db = Nothing

   Debug.Print "MyNewField Adicionado!"

  End Function

Function CreateViewDDL()

       Dim strSql As String

   Let strSql = "CREATE VIEW qry1 as SELECT tblInvoice.* from tblInvoice;"       CurrentProject.Connection.Execute strSql  End Function    Sub DropFieldDDL()      Dim strSql As String         

   CurrentProject.Connection.Execute strSql

  End Function

Sub DropFieldDDL()

      Dim strSql As String

   Let strSql = "ALTER TABLE [MyTable] DROP COLUMN [DeleteMe];"       DBEngine(0)(0).Execute strSql, dbFailOnError  End Sub    Sub ModifyFieldDDL()     Dim strSql As String         

   DBEngine(0)(0).Execute strSql, dbFailOnError

  End Sub

Sub ModifyFieldDDL()

     Dim strSql As String

   Let strSql = "ALTER TABLE MyTable ALTER COLUMN MyText2Change TEXT(100);"       DBEngine(0)(0).Execute strSql, dbFailOnError  End Sub    Function AdjustAutoNum()     Dim strSql As String         

   DBEngine(0)(0).Execute strSql, dbFailOnError

  End Sub

Function AdjustAutoNum()

     Dim strSql As String

   Let strSql = "ALTER TABLE MyTable ALTER COLUMN ID COUNTER (1000,1);"       CurrentProject.Connection.Execute strSql  End Function    Function DefaultZLS()      Dim strSql As String         

   CurrentProject.Connection.Execute strSql

  End Function

Function DefaultZLS()

      Dim strSql As String

   Let strSql = "ALTER TABLE MyTable ADD COLUMN MyZLSfield TEXT (100) DEFAULT """";"       CurrentProject.Connection.Execute strSql  End Function

   CurrentProject.Connection.Execute strSql

  End Function

Tags: VBA, Acces, DDL, DML, DAO, ADO, CREATE, ALTER,DROP,índices, constraints, views e procedures,queries, usuário, grupos, users, groups, index, JET 4, ADOX