Views

Histats

Vitrine

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, 


LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...