Views

...

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.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

VBA Excel - Usando o MS Excel como banco de dados


Sim, às vezes nos é solicitado desenvolver uma solução no MS Excel que devia ser desenvolvida no MS Access. Precisamos desenvolver um formulários para dataentry, um ambiente para o armazenamento dos dados.

Imaginemos termos uma planilha com dados de Fornecedor e outra planilha de Produto. Como faríamos para trazer os produtos de um determinado fornecedor?


Todo o processo precisaria ser feito via código, um loop varrendo os produtos e identificando o fornecedor e copiando o resultado para outro lugar. Ou através do uso de fórmula, que dependendo da massa de dados pode se tornar inviável.

 

E se fosse possível fazer um SELECT com JOINFicaria bem mais fácil certo?

 

Se seguíssemos um modelo de desenvolvimento padrão, o nosso código ficaria mais organizado. Precisamos de um segundo arquivo MS Excel pra ser o nosso banco de dados. Nada é perfeito, só é possível executar SELECT e INSERT. Os comandos de UPDATE e DELETE a gente improvisa.

 

Segue abaixo algumas funções que auxiliam no trabalho com o Excel como banco de dados. E certamente para outras versões do Excel devemos alterar a string de conexão.

 

Function ConectaXL() As Boolean

'*****************************************

'Nome: ConectaXL

'Autor: Rafael Gomes dos Santos

'Data: 04/05/2010

'Descrição: Conexão ADO com planilha Excel (só consulta)

'Revisão: 04/05/2010

'*****************************************

 

Let ConectaXL = True

 

On Error GoTo erro1:

 

With cn

    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xlDB & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"

    .Open

End With

 

erro1:

 

If Err.Number <> 0 Then

   

    Let ConectaXL = False

   

End If

 

End Function

 

 

Function DesconectaXL() As Boolean

 

'*****************************************

'Nome: DesconectaXL

'Autor: Rafael Gomes dos Santos

'Data: 04/05/2010

'Descrição: Desconecta ADO com planilha Excel

'Revisão: 04/05/2010

'*****************************************

 

On Error GoTo erro1:

 

    Let DesconectaXL = True

 

    cn.Close

   

    Set cn = Nothing

   

erro1:

 

If Err.Number <> 0 Then

 

    Let DesconectaXL = False

 

End If

   

End Function

 

 

Function ConectaXLAtualizavel() As Boolean

 

'*****************************************

'Nome: ConectaXLAtualizavel

'Autor: Rafael Gomes dos Santos

'Data: 04/05/2010

'Descrição: Conexão ADO com planilha Excel (Permite INSERT)

'Revisão: 04/05/2010

'*****************************************

 

Let ConectaXLAtualizavel = True

 

On Error GoTo erro1:

 

With cn

    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xlDB & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes"";"

    .Open

End With

 

erro1:

 

If Err.Number <> 0 Then

   

    ConectaXLAtualizavel = False

   

End If

 

End Function

 

 

Function ExcluiRegistro( _

Tabela As String, _

Campo As String, _

Valor As String _

) As Boolean

 

 

    '*****************************************
    'Nome: ExcluiRegistro
    'Autor: Rafael Gomes dos Santos
    'Data: 04/05/2010
    'Descrição: Exclui registro de tabela na planilha banco de dados
    'Revisão: 04/05/2010

    '*****************************************
 
 
    Dim xl As New Excel.Application
    Dim wkb As Workbook
    Dim wsh As Worksheet
   
    Dim c As Integer
    Dim l As Integer
   
    Let ExcluiRegistro = False
   
    Set wkb = xl.Workbooks.Open(xlDB)
 
    Set wsh = wkb.Worksheets(Tabela)
   
    Let c = 1
   
    Do While wsh.Cells(1, c) <> ""
 
        If wsh.Cells(1, c) = Campo Then
 
            Exit Do
       
        End If
 
        Let c = c + 1
 
    Loop
   
    If wsh.Cells(1, c) <> "" Then
   
        Let l = 2
       
        Do Until wsh.Cells(l, c) = ""
   
            If wsh.Cells(l, c) = Valor Then
           
                wsh.Cells(l, c).EntireRow.Delete
                Let ExcluiRegistro = True
                Exit Do
               
            End If
   
            Let l = l + 1
       
        Loop
       
    End If
 
    Set wsh = Nothing
    wkb.Close True
    Set wkb = Nothing
    xl.Quit
    Set xl = Nothing

 

End Function

 

 

Function RegistroExiste( _

Tabela As String, _

Campo As String, _

Valor As String, _

Optional Tipo As String, _

Optional Campo2 As String, _

Optional Valor2 As String, _

Optional Tipo2 As String, _

Optional Campo3 As String, _

Optional Valor3 As String, _

Optional Tipo3 As String _

) As Boolean

 

    '*****************************************

    'Nome: RegistroExiste

    'Autor: Rafael Gomes dos Santos

    'Data: 04/05/2010

    'Descrição: Retorna TRUE se o registro existir na planilha banco de dados. Limitado a 3 parâmetros.

    'Revisão: 04/05/2010

    '*****************************************

 

 

    Dim rs As New ADODB.Recordset

 

    Dim strSQL As String

 

    RegistroExiste = False

 

    If ConectaXLAtualizavel = False Then

       

        MsgBox "Impossível conectar"

        Exit Function

   

    End If

   

    rs.ActiveConnection = cn

   

    Let strSQL = "SELECT * FROM [" & Tabela & "$] WHERE "

   

    If Tipo = "Number" Then

        strSQL = strSQL & Campo & " = " & Valor

    Else

        strSQL = strSQL & Campo & " = '" & Valor & "'"

    End If

   

    If Campo2 <> "" Then

        If Tipo2 = "Number" Then

            strSQL = strSQL & " " & Campo2 & " = " & Valor2

        Else

            strSQL = strSQL & " " & Campo2 & " = '" & Valor2 & "'"

        End If

    End If

   

    If Campo3 <> "" Then

        If Tipo3 = "Number" Then

            strSQL = strSQL & " " & Campo3 & " = " & Valor3

        Else

            strSQL = strSQL & " " & Campo3 & " = '" & Valor3 & "'"

        End If

    End If

 

    rs.Source = strSQL

 

    rs.LockType = adLockPessimistic

    rs.Open

 

    If Not rs.EOF Then

       

        RegistroExiste = True

        

    End If

 

    If DesconectaXL = False Then

       

        MsgBox "Impossível desconectar"

        Exit Function

   

    End If

 

End Function

 

 

Fazendo um SELECT com JOIN na planilha Excel.

 

    If ConectaXL = False Then

       

        MsgBox "Impossível conectar"

        Exit Sub

   

    End If

   

    Let rs.ActiveConnection = cn

   

      Let strsql = "SELECT [Jurado$].Nome,"

Let strsql = strsql & " [Jurado$].Cargo,"

Let strsql = strsql & " [Jurado$].Empresa,

Let strsql = strsql & " [Jurado$].CargoJuri"

Let strsql = strsql & " FROM [Jurado$]"

Let strsql = strsql & " INNER JOIN [CargoJuri$]"

Let strsql = strsql & " ON [Jurado$].CargoJuri = [CargoJuri$].Cargo"

Let strsql = strsql & " WHERE [Jurado$].RegiaoJuri = 'LESTE/OESTE'"

Let strsql = strsql & " ORDER BY [CargoJuri$].Ordem"

 

Let rs.Source = strsql

Let rs.LockType = adLockPessimistic

   

      rs.Open

 

 

    If ConectaXLAtualizavel = False Then

        MsgBox "Impossível conectar"

        Exit Sub

    End If

   

    Let rs.ActiveConnection = cn

   

    Let rs.Source = "SELECT * FROM [Inscritos$] WHERE" _

    & " Categoria = '" & Me.cmbCategoria & "'" _

    & " AND Regiao = '" & Me.cmdRegiao & "'" _

    & " AND Posicao = " & Me.txtPosicao

   

    Let rs.LockType = adLockPessimistic

    rs.Open

   

    If Not rs.EOF Then

    

        rs.MoveFirst

   

        Let rs("Categoria") = Me.cmbCategoria

        Let rs("Regiao") = Me.cmdRegiao

        Let rs("Duracao") = Me.txtDuracao

        Let rs("Posicao") = Me.txtPosicao

        Let rs("Titulo") = Me.txtTitulo

   

        rs.Update

        rs.Close

        Set rs = Nothing

   

    End If

 

    If DesconectaXL = False Then

        MsgBox "Não foi possível se desconectar do Banco de Dados. por favor reinicie o sistema."

        Exit Sub

    End If


Referência: SistemaEmVBA.com

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

Tags
VBA, Excel, Icon, ícones, Conditional, Formatting, 


eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine