Views

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 JOIN? Ficaria 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, 




Tags: , , , , ,

Nenhum comentário:

Postar um comentário

Assinar: Postar comentários (Atom)
diHITT - Notícias