Excel como banco de dados - VBA

Como desenvolvedores VBA, às vezes precisamos lidar com situações bem específicas. Um exemplo, é quando o cliente nos contrata para desenvolver uma solução em Excel que tinha tudo para ser desenvolvida seguindo um modelo de desenvolvimento padrão (com formulários de entrada, interface e armazenamento em banco de dados), mas que por motivos de força maior o cliente deseja que este seja desenvolvido obrigatoriamente em Excel, aproveitando a não obrigatoriedade de instalação e banco de dados.

Pensando nisso, qual seria a melhor solução a adotar?

Criar uma pasta de trabalho com formulários e planilhas ocultas que servirão como BD?

Com certeza esta é a primeira solução que viria há minha cabeça.

Mas pensando novamente.  Imagine que você tem uma planilha Fornecedor e outra planilha Produto. Como você faria 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 JOIN?

Ficaria bem mais fácil certo?

Como ficaria mais organizado nosso código se seguíssemos um modelo de desenvolvimento padrão.

E isso é possível. Neste caso só precisamos de um segundo arquivo Excel que seria nosso banco de dados.

Mas claro que nada é perfeito, só é possível executar SELECT e INSERT. Os comandos de UPDATE e DELETE a gente precisa improvisar.

Segue abaixo algumas funções que auxiliam no trabalho do Excel 2007 como banco de dados.

Lembrando que para outras versões do Excel devemos alterar a string de conexão.

Conecta com Excel para Consulta

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

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

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

    ConectaXL = False

End If

End Function

Desconecta Excel

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:

    DesconectaXL = True

    cn.Close

    Set cn = Nothing

erro1:

If Err.Number <> 0 Then

    DesconectaXL = False

End If

End Function

Conecta com Excel (permitindo INSERT)

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

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

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

Exclui Registro da Planilha Banco de Dados

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

    ExcluiRegistro = False

    Set wkb = xl.Workbooks.Open(xlDB)

    Set wsh = wkb.Worksheets(Tabela)

    c = 1

    Do While wsh.Cells(1, c) <> ""

        If wsh.Cells(1, c) = Campo Then

            Exit Do

        End If

        c = c + 1

    Loop

    If wsh.Cells(1, c) <> "" Then

        l = 2

        Do Until wsh.Cells(l, c) = ""

            If wsh.Cells(l, c) = Valor Then

                wsh.Cells(l, c).EntireRow.Delete

                ExcluiRegistro = True

                Exit Do

            End If

            l = l + 1

        Loop

    End If

    Set wsh = Nothing

    wkb.Close True

    Set wkb = Nothing

    xl.Quit

    Set xl = Nothing

End Function

Checa se o registro existe na planilha

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

    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

SELECT com JOIN

Fazendo um SELECT com JOIN na planilha Excel.

    If ConectaXL = False Then

        MsgBox "Impossível conectar"

        Exit Sub

    End If

    rs.ActiveConnection = cn

      strsql = “SELECT [Jurado$].Nome,”

strsql = strsql & “ [Jurado$].Cargo,”

strsql = strsql & “ [Jurado$].Empresa,

strsql = strsql & “ [Jurado$].CargoJuri”

strsql = strsql & “ FROM [Jurado$]”

strsql = strsql & “ INNER JOIN [CargoJuri$]”

strsql = strsql & “ ON [Jurado$].CargoJuri = [CargoJuri$].Cargo”

strsql = strsql & “ WHERE [Jurado$].RegiaoJuri = 'LESTE/OESTE'”

strsql = strsql & “ ORDER BY [CargoJuri$].Ordem”

rs.Source = strsql

rs.LockType = adLockPessimistic

      rs.Open

Atualizar dados

    If ConectaXLAtualizavel = False Then

        MsgBox "Impossível conectar"

        Exit Sub

    End If

    rs.ActiveConnection = cn

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

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

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

    & " AND Posicao = " & Me.txtPosicao

    rs.LockType = adLockPessimistic

    rs.Open

    If Not rs.EOF Then

        rs.MoveFirst

        rs("Categoria") = Me.cmbCategoria

        rs("Regiao") = Me.cmdRegiao

        rs("Duracao") = Me.txtDuracao

        rs("Posicao") = Me.txtPosicao

        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