Permite abrir uma URL a partir do Access com outro navegador que não o IE

O caminho informado em  varCaminho deve ser alterado manualmente com o
 Caminho+Nome do executável do seu navegador

—- C Ó D I G O —-

    Dim varCaminho As String
    Dim varURL As String
    Dim varTarefa As Double

    varCaminho = "c:\program files\mozilla firefox\firefox.exe" ' Caminho do executável do navegador
    varURL = "https://accessporexemplo.wordpress.com/" 'Endereço da URL

    varTarefa = Shell(varCaminho & " " & varURL, vbNormalFocus)

    If varTarefa = 0 Then
        MsgBox "Não é possível abrir o navegador"
    End If

Caixa de mensagem com 2 linhas

—- C Ó D I G O —-

MsgBox ("LINHA1" & Chr(13) & Chr(10) & "LINHA2")

Caminho onde está o programa

Determina o caminho do banco de dados

—- C Ó D I G O —-

    Dim varCaminho As String 'Caminho do arquivo
        'Caminho do arquivo para a comparação abaixo
    varCaminho = Application.CurrentProject.Path

Colocar o cursor no final do texto de um campo

Normalmente quando um campo recebe o foco, o texto completo existente nele é selecionado.
Se você quiser que ao entrar em um campo o cursor seja posicionado no final do texto,
 use a função abaixo

Substituição no seu código:
NOMEDOCAMPO

—- C Ó D I G O —-

Private Sub Description_Enter()

    Me!NOMEDOCAMPO.SelStart = Me!NOMEDOCAMPO.SelLength

End Sub

Como abrir um formulário ao clicar com o botão direito do mouse e não abrir o Menu de contexto

Quando se clica com o botão direito do mouse num controle em um 
formulário, é aberto o Menu de contexto.

Este exemplo mostra como clicar em um controle com esse botão e abrir um
formulário chamado "Form2" sem que seja aberto também o Menu de contexto.
Esse formulário pode ser usado como seu próprio menu de contexto ou
então para uma outra função qualquer.

No código, esse controle chama-se : SEUCONTROLE

Para funcionar, você tem que copiar os códigos MouseDown e MouseUp para os 
locais correspondentes do seu controle.

Considere como uma gambiarra (SendKeys) que funciona. Certamente há uma maneira mais
correta e elegante de conseguir o desejado !

—- C Ó D I G O —-

'As constantes para saber qual botão foi pressionado

'Button   The button that was pressed (MouseDown) or released (MouseUp) to trigger
'the event.
'
'Constant Description
'
'acLeftButton The bit mask for the left mouse button.
'
'acRightButton The bit mask for the right mouse button.
'
'acMiddleButton The bit mask for the middle mouse button.
'

_______________________________________________________________________________________________

Private Sub SEUCONTROLE_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button = acRightButton Then
    
        DoCmd.OpenForm "Form2"
    
    End If

End Sub

_______________________________________________________________________________________________

Private Sub SEUCONTROLE_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SendKeys "%" 'Simula a tecla ALT
End Sub

Como atualizar a lista de itens de uma caixa de combinação após adicionar um item diferente

Quando se adiciona um item ainda não existente à lista de itens de uma
caixa de combinação, para que o novo item apareça na lista na próxima vez 
que você for usá-la, use o código abaixo.

—- C Ó D I G O —-

    Me.NOMEDOCAMPO.Refresh 'Salva o registro
    Me.NOMEDOCAMPO.Requery 'Refaz a consulta no campo

Como usar Close e Nothing

Essas instruções só valem para OBJETOS (não para variáveis)

A instrução Close anula a instrução Set (mas não a instrução Dim)
A instrução Set ... = Nothing anula a instrução Dim

Com Close você anula a conexão com o banco de dados, mas não elimina 
a definição do objeto. Com Nothing você anula a definição do objeto (Dim ...)

Dica - como escrever a instrução Close e Nothing numa linha só:
 rst.Close: Set rst = Nothing

Observe no código que a definição do rst é utilizada duas vezes através 
do Close e só no final é anulada.

—- C Ó D I G O —-

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    
    Set dbs = CurrentDb
    Set rst = db.OpenRecordset("SELECT * ... [instrução SQL 1]")
        
        ' Seu código ...
    
    rst.Close

    Set rst = db.OpenRecordset("SELECT * ... [instrução SQL 2]")
        
        ' Seu código ...
    
        
        ' Final do código ...

    rst.Close
    dbs.Close
    Set rst = Nothing
    Set dbs = Nothing

Criar um arquivo em uma pasta no disco

Cria um arquivo texto (.txt) a partir do nome digitado em um campo
Verifica a existência de caracteres inválidos no nome digitado
Define o caminho do arquivo para uma sub-pasta da pasta onde o programa está
Verifica se o arquivo a ser criado já existe

Campo onde é digitado o nome do arquivo : txNOMEARQUIVO
Sub-pasta da pasta onde o banco de dados está : NOMEDAPASTA

A função abaixo abre um arquivo com o programa cuja extensão está registrada no Windows
Função : fHandleFile

Pode ser encontrada no site
http://access.mvps.org/access/api/api0018.htm

—- C Ó D I G O —-

Private Sub btOK_Click()
        
        'Verifica se o campo está preenchido
    If Nz(Len(Me. txNOMEARQUIVO)) = 0 Then
            'Caso o campo esteja vazio, solicita o preenchimento
        MsgBox "Preencha o campo com o nome do arquivo.", _
            vbInformation + vbOKOnly + vbDefaultButton1, "Falta de informação"
        
        Me.txNOMEARQUIVO.SetFocus
        Exit Sub
    
    Else
    
            'Verifica existência de caracter inválido no nome do arquivo
        If InStr(1, Me.txNOMEARQUIVO, "/") Then
            MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> /" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
        
        If InStr(1, Me.txNOMEARQUIVO, "\") Then
            MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> \" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
        
        If InStr(1, Me.txNOMEARQUIVO, ":") Then
           MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> :" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
    
        If InStr(1, Me.txNOMEARQUIVO, "*") Then
           MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> *" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
    
        If InStr(1, Me.txNOMEARQUIVO, "?") Then
           MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> ?" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
    
        If InStr(1, Me.txNOMEARQUIVO, "'") Then
           MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> '" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
    
        If InStr(1, Me.txNOMEARQUIVO, " ") Then
           MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> >" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
    
        If InStr(1, Me.txNOMEARQUIVO, "|") Then
           MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> |" & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
        
        If InStr(1, Me.txNOMEARQUIVO, ".") Then
           MsgBox "Um nome de arquivo não pode ter o " & _
                "caracter -> ." & vbCrLf & vbCrLf & "Por favor, corrija.", _
                vbExclamation + vbOKOnly + vbDefaultButton1, "Caracter inválido"
            Exit Sub
        End If
    
    
            'Define o caminho do arquivo criado
            'Caminho : Caminho do programa\NOMEDAPASTA\
        Dim varCaminho As String 'Caminho do arquivo
        varCaminho = Application.CurrentProject.Path & "\NOMEDAPASTA\"
        
            'Verifica se a sub-pasta NOMEDAPASTA existe
        If Dir(varCaminho)  "" Then
            
            'Caminho existe
        
        Else
            'Caminho não existe
            'Informa o usuário sobre a criação do caminho e cria a sub-pasta
            MsgBox "Este arquivo e todos os demais que forem " & _
                "criados a partir de agora" & vbCrLf & "serão salvos numa " & _
                "sub-pasta da pasta do programa." & vbCrLf & vbCrLf & "O " & _
                "caminho completo da sub-pasta é:" & vbCrLf & vbCrLf & _
                varCaminho, vbInformation + vbOKOnly + vbDefaultButton1, _
                "Pasta de arquivos"
                
                'Cria a sub-pasta
            MkDir (varCaminho)
        End If
            
        
            'Esta variável é usada para definição do nome do arquivo a
            'ser salvo com as correções de caracteres inválidos
        Dim varArquivo As String 'Nome do arquivo
        varArquivo = Me.txNOMEARQUIVO
            
            'Variável para o caminho + nome do arquivo + extensão (txt)
        Dim varCamiArqu As String
        varCamiArqu = varCaminho & varArquivo & ".txt"
        
        'Verifica se já existe arquivo com o mesmo nome
        varArqtxt = varArquivo & ".txt"
        
            'Mensagem com opção de sobreposição ou não do arquivo
        If Dir(varCamiArqu) = varArqtxt Then
            Dim respArqExiste As Byte
            respArqExiste = _
                MsgBox("Você já criou anteriormente um arquivo com este " & _
                "nome !" & vbCrLf & vbCrLf & "Deseja substituir o arquivo " & _
                "existente ?" & vbCrLf & vbCrLf & "SIM : O arquivo " & _
                "existente será excluído e criado um novo arquivo com este " & _
                "nome." & vbCrLf & vbCrLf & "NÃO : Você poderá dar um " & _
                "novo nome para o arquivo" & vbCrLf & vbCrLf & vbCrLf & _
                vbCrLf, vbCritical + vbYesNo + vbDefaultButton2, "Arquivo existe")

                'Cria uma variável para a resposta dada
            Dim varExiste as String
            If respArqExiste = vbYes Then
                    'Cria fisicamente o arquivo vazio e fecha    
                Open varCamiArqu For Output As #1
                Close #1        
                    '
                fHandleFile varCamiArqu, 1
                
            Else 'vbNo (Default)
                
                Exit Sub
            
            End If

        End If
    
    End If

End Sub

Criar uma consulta temporária a partir de um formulário

Este código pode ser útil quando você necessita criar uma consulta a partir
de um formulário que é a seleção de registros de um outro formulário

Código 1 :
Cria uma consulta temporária a partir da origem dos registros
 (recordsouce) de um formulário.

Códigos 2a e 2b:
Deleta a consulta temporária dentro e fora do procedimento

—- C Ó D I G O —-

'Código 1
    '
    Dim dbs As Database
    Dim DEFINICAODACONSULTA As QueryDef
    Dim varSQL As String
    
    Set dbs = CurrentDb
        
        'SQL da origem dos registros do formulário
    varSQL = Forms!NOMEDOFORMULARIO.RecordSource
        
        'Cria a consulta temporária a partir da SQL acima
    Set DEFINICAODACONSULTA = dbs.CreateQueryDef("NOMEDACONSULTATEMPORARIA", varSQL)
    
    
'Código 2a - Excluindo a consulta dentro do mesmo procedimento
    '
    dbs.QueryDefs.Delete DEFINICAODACONSULTA.Name
    
    
'Código 2b - Excluindo a consulta em outro procedimento
    '
    Set dbs = CurrentDb
    dbs.QueryDefs.Delete "NOMEDACONSULTATEMPORARIA"

Desativar uma tecla

Através do evento Keypress é possível interceptar qual tecla foi acionada através do
argumento KeyAcii.
A instrução compara o KeyAscii com a constante KeyCode do Access referente a uma
determinada tecla (no exemplo vbKeyEsc - a tecla Esc) 
Atribuindo o valor zero ao argumento KeyAscii o pressionamento da tecla é cancelado.

Tabela KeyAscii
http://www.rolbe.com/2009/03/03/vb-keyascii-chart/

Tabela KeyCode
http://www.rolbe.com/2009/03/07/vb-keycode-constants-chart/

—- C Ó D I G O —-

Private Sub Text1_KeyPress(KeyAscii As Integer)
     
     If KeyAscii = vbKeyEsc Then
        KeyAscii = 0
     End If
     
End Sub

Encontrar o registro que coincide com o valor de um controle

Localiza o registro que coincide com o conteúdo de um controle

Você deve fazer as seguintes substituições no código:

NOMEDOCAMPO -> Nome do campo onde localizar do seu form
NOMEDOCONTROLE -> Nome do controle com os dados a localizar

O código supõe que se está usando uma caixa de combinação como fonte de dados

—- C Ó D I G O —-

    Dim rs As Object
    
    Set rs = Me.Recordset.Clone
    rs.FindFirst "[NOMEDOCAMPO] = '" & Me![NOMEDOCONTROLE] & "'"
    
    If rs.NoMatch Then
        'Seu código caso o registro não seja encontrado
        
    Else
        'Seu código caso o registro seja encontrado
        Me.Bookmark = rs.Bookmark    
    End If
    
    rs.Close
    Set rs = Nothing

Excluir – Mensagem personalizada

Cria uma mensagem personalizada para exclusão de um registro.
A mensagem apresenta o conteúdo do campo que vai ser excluído

No exemplo, exclui o registro referente ao campo: MEUCAMPO

—- C Ó D I G O —-

    DoCmd.SetWarnings False

    Dim varExc As Byte
        varExc = MsgBox("Deseja " & _
        "excluir o registro :" & vbCrLf & vbCrLf & Me.MEUCAMPO, _
        vbQuestion + vbYesNo + vbDefaultButton1, "Excluir registro")

    If varExc = vbYes Then ' (Default)
        DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
        DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
        
        Me.Refresh
        DoCmd.SetWarnings True
    Else 'vbNo
        DoCmd.SetWarnings True
    End If

Função de Data : DateSerial

Sintaxe VBA: DateSerial (ano, mês, dia )
Sintaxe em consultas: DataSerial(ano; mês; dia)

—- C Ó D I G O —-

'*** MÊS ***
'
Dim varData as Date

'Primeiro dia do mês anterior
varData = DateSerial(Year(Date), Month(Date) - 1, 1) 

'Primeiro dia deste mês
varData = DateSerial(Year(Date), Month(Date), 1) 

'Primeiro dia do próximo mês 
varData = DateSerial(Year(Date), Month(Date) + 1, 1)

'Último dia do mês anterior
varData = DateSerial(Year(Date), Month(Date), 0)

'Último dia deste mês
varData = DateSerial(Year(Date), Month(Date) + 1, 0)

'Último dia do próximo mês
varData =  DateSerial(Year(Date), Month(Date) + 2, 0)

'*** TRIMESTRE ***
'
'Primeiro dia do trimestre anterior
varData = DateSerial(Year(Date), (Month(Date)) - 3, 1)
    
'Primeiro dia deste trimestre
varData = DateSerial(Year(Date), Int((Month(Date) - 1) / 3) * 3 + 1, 1)

'Primeiro dia do próximo trimestre
varData = DateSerial(Year(Date), Month(Date) + 1, 1)

'Último dia do trimestre anterior
varData = DateSerial(Year(Date), Month(Date), 0)

'Último dia deste trimestre
varData = DateSerial(Year(Date), Int((Month(Date) - 1) / 3) * 3 + 4, 0)

'Último dia do próximo trimestre
varData = DateSerial(Year(Date), Month(Date) + 4, 0)

Ilumina o texto de um campo

Use a instrução quando, ao enviar o foco para um campo, quiser que o texto seja destacado

—- C Ó D I G O —-

    If Len(Me.NOMEDOCAMPO)  0 Then
        Me.NOMEDOCAMPO.SetFocus
        Me.NOMEDOCAMPO.SelStart = 0
        Me.NOMEDOCAMPO.SelLength = Len(Me.NOMEDOCAMPO)
    End If

Inserir Todos em uma caixa de combinação

Mostra como colocar "Todos" como um ítem da caixa de combinação

Substituições no seu código:
NOMEDACAIXADECOMBINAÇÃO

—- C Ó D I G O —-

Private Sub Form_Open(Cancel As Integer)
  With Me.NOMEDACAIXADECOMBINAÇÃO
    .RowSourceType = "Value List"
    .RowSource = "(Todos);" & .RowSource
  End With
End Sub

Lista de consultas fechadas de um banco de dados

Imprime a lista de consultas fechadas de um banco de dados na Janela Imediata

—- C Ó D I G O —-

Public Sub ConsultasFechadas()
    Dim varListaConsultas As AccessObject
    For Each varListaConsultas In CurrentData.AllQueries
        
        'Imprime a lista de consultas fechadas na Janela Imediata
        Debug.Print varListaConsultas.Name
    
    Next
End Sub

Lista de formulários de um banco de dados em caixa de combinação

Preenche a lista de formulários de um banco de dados em uma caixa de combunação
O caracter Chr(34) corresponde a aspas duplas

Substituições no código:
SUACC = nome da sua caixa de combinação

O código está no evento Ao Carregar de um formulário

—- C Ó D I G O —-

Private Sub Form_Load()
   
        'Variável para a lista de formulários
    Dim varLista As String
    varLista = ""
   
        'Ciclo pela coleção de tabelas
        'Constroi a string que será origem da linha da caixa de combinação
    Dim obj As AccessObject
    For Each obj In CurrentProject.AllForms
        varLista = varLista & Chr(34) & obj.Name & Chr(34) & ";"
    Next obj
    
   
        'Define a origem da linha como Lista de valores
    Me!SUACC.RowSourceType = "Value List"
        'Define a origem da linha
    Me!SUACC.RowSource = varLista
    
        'Mostra a 1ª opção da lista
    Me!SUACC.Value = Me!SUACC.ItemData(0)
       'Garante que só possa ser selecionado um item da lista
    Me!SUACC.LimitToList = True
   
End Sub

Lista de formulários abertos em um banco de dados

Imprime a lista de formulários abertos de um banco de dados na Janela Imediata

—- C Ó D I G O —-

Public Sub FormulariosAbertos()
    Dim varFormsAbertos As Form
    For Each varFormsAbertos In Forms
        
            'Imprime a lista de formulários abertos na Janela Imediata
        Debug.Print varFormsAbertos.Name
        
    Next
End Sub

Lista de formulários fechados de um banco de dados

Imprime na janela imediata a lista de todos os formulários fechados do banco de dados

—- C Ó D I G O —-

    Public Sub FormulariosFechados()
        
            'Ciclo pela lista de formulários fechados do banco de dados
        Dim varFormsFechados As AccessObject
        For Each varFormsFechados In CurrentProject.AllForms
                'Imprime a lista na Janela Imediata
            Debug.Print varFormsFechados.Name
    
        Next

    End Sub

Lista de relatórios abertos de um banco de dados

Imprime a lista de relatórios abertos de um banco de dados na Janela Imediata

—- C Ó D I G O —-

Public Sub RelatoriosAbertos()
    Dim varRelatoriosAbertos As Report
    For Each varRelatoriosAbertos In Reports
        
        'Imprime a lista de relatórios abertos na Janela Imediata
        Debug.Print varRelatoriosAbertos.Name
        
    Next
End Sub

Lista de relatórios de um banco de dados em caixa de combinação

Preenche a lista de relatórios de um banco de dados em uma caixa de combunação
O caracter Chr(34) corresponde a aspas duplas

Substituições no código:
SUACC = nome da sua caixa de combinação

O código está no evento Ao Carregar de um formulário

—- C Ó D I G O —-

rivate Sub Form_Load()
   
        'Variável para a lista de relatórios
    Dim varLista As String
    varLista = ""
   
        'Ciclo pela coleção de relatórios
        'Constroi a string que será origem da linha da caixa de combinação
    Dim obj As AccessObject
    For Each obj In CurrentProject.AllReports
        varLista = varLista & Chr(34) & obj.Name & Chr(34) & ";"
    Next obj
    
   
        'Define a origem da linha como Lista de valores
    Me!SUACC.RowSourceType = "Value List"
        'Define a origem da linha
    Me!SUACC.RowSource = varLista
    
        'Mostra a 1ª opção da lista
    Me!SUACC.Value = Me!SUACC.ItemData(0)
        'Garante que só possa ser selecionado um item da lista
    Me!SUACC.LimitToList = True
   
End Sub

Lista de relatórios fechados de um banco de dados

Imprime a lista de relatórios fechados de um banco de dados

—- C Ó D I G O —-

Public Sub ListaDeRelatorios()

    Dim varRelatoriosFeechados As AccessObject
    For Each varRelatoriosFeechados In CurrentProject.AllReports
            'Imprime a lista na Janela Imediata
        Debug.Print varRelatoriosFeechados.Name
        
    Next
End Sub

Lista de tabelas e consultas de um banco de dados em caixa de combinação

Preenche a lista de tabelas e consultas de um banco de dados em uma caixa de combunação
O caracter Chr(34) corresponde a aspas duplas

Substituições no código:
SUACC = nome da sua caixa de combinação

O código está no evento Ao Carregar de um formulário

—- C Ó D I G O —-

Private Sub Form_Load()
        'Variável para a lista
    Dim varLista As String
    varLista = ""
    
        'Ciclo pela lista de tabelas
    Dim tbl As AccessObject
    For Each tbl In CurrentData.AllTables
            'Exclui da lista as tabelas do sistema do Access
        If Not Left(tbl.Name, 4) = "MSys" Then
            varLista = varLista & Chr(34) & "Tabela: " & tbl.Name & Chr(34) & ";"
        End If
    Next tbl
    
        'Ciclo pela lista de consultas
    Dim qry As AccessObject
    For Each qry In CurrentData.AllQueries
        varLista = varLista & Chr(34) & "Consulta: " & qry.Name & Chr(34) & ";"
    Next qry
    
        'Define a origem da linha como lista de valores
    Me!SUACC.RowSourceType = "Value List"
        'Define a origem da linha com a variável
    Me!SUACC.RowSource = varLista
    
        'Mostra o 1º item da lista na caixa de combinação
    Me!SUACC.Value = Me!SUACC.ItemData(0)
        'Garante que só possa ser selecionado um item da lista
    Me!SUACC.LimitToList = True
End Sub

Lista de tabelas fechadas de um banco de dados

Imprime a lista de tabelas fechadas de um banco de dados na Janela Imediata

—- C Ó D I G O —-

Public Sub TabelasFechadas()
    Dim varListaTabelas As AccessObject
    For Each varListaTabelas In CurrentData.AllTables
        
            'Imprime a lista de tabelas fechadas na Janela Imediata
        Debug.Print varListaTabelas.Name
    
    Next
End Sub

Preenche uma caixa de combinação a partir de uma SQL

Usa uma SQL como fonte de dados para a  lista de valores de uma caixa de combinação.

Permite definir o número de colunas da caixa de combinação
Permite definir os títulos das colunas 

Caso você altere o número de colunas, será necessário fazer as alterações correspondentes em :
1) varTitulo
2) Nas instruçãos "varCol = rst(0) & ";" & rst(1)"  dentro da instrução If 

Substituições no seu código:
NOMEDACAIXADECOMBINACAO
NOMEDATABELA/CONSULTA

—- C Ó D I G O —-

Private Sub SeuComando_Click()
    
    Dim varCol As String       'para conteúdo da lista de valores da 
    Dim varTitulo As String    'título das colunas
    
    Set dbs = CurrentDb
        
    Me.NOMEDACAIXADECOMBINACAO.ColumnCount = 2    'Define a quantidade de colunas
    varTitulo = "titulo 1" & ";" & "titulo 2"    'Define o titulo das colunas
    Me.NOMEDACAIXADECOMBINACAO.RowSourceType = "Value List"    'Define o tipo de rowsource como Lista de valores
    Me.NOMEDACAIXADECOMBINACAO.ColumnHeads = True    'Define que é para mostrar o título das colunas
    
    varSQL = "Select * from NOMEDATABELA/CONSULTA"    'Define a SQL
    Set rst = dbs.OpenRecordset(varSQL)    'Cria um recorset a partir da SQL
        
    While Not rst.EOF    'Ciclo pelos registros do recorset
            'Constroi a Lista de valores
        If varCol = "" Then
            varCol = rst(0) & ";" & rst(1)
        Else
            varCol = varCol & ";" & rst(0) & ";" & rst(1)
        End If
           
        rst.MoveNext
     
    Wend
     
        'Preenche o rowsource da caixa de combinação com o título e a lista de valores
    Me.NOMEDACAIXADECOMBINACAO.RowSource = varTitulo & ";" & varCol

End Sub

Recordset – Como adicionar um registro 1

Usa o método AddNew

—- C Ó D I G O —-

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("NOMEDATABELAouNOMEDACONSULTA")

    rst.AddNew
    rst!NOMEDOCAMPO = "SUAINFORMAÇÃO"
    rst.Update

Recordset – Como adicionar um registro 2

—- C Ó D I G O —-

    Dim dbs As Database
    Dim rst As Recordset
    
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("NOMEDATABELA", dbOpenDynaset)
    
    With rst
        .AddNew
        .NOMEDOCAMPO = "SUAINFORMAÇÃO"
        .Update
    End With

Recordset – Como criar a partir de um formulário

Usa a propriedade RecordsetClone

—- C Ó D I G O —-

    Dim rst As DAO.Recordset
    Set rst = Forms!NOMEDOFORMULÁRIO.RecordsetClone

Recordset – Criar a partir de uma consulta

—- C Ó D I G O —-

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("NOMEDACONSULTA")

Recordset – Criar a partir de uma tabela

—- C Ó D I G O —-

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("NOMEDATABELA")

Recordset – Detectando os limites de um

Usa as propriedades :

BOF : início do arquivo
EOF : fim do arquivo

—- C Ó D I G O —-

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset("NOMEDATABELAouCONSULTA")

   Do Until rst.EOF
      '
      ' Suas instruções
      '
      rst.MoveNext
   Loop

   rst.MoveLast

   Do Until rst.BOF
      '
      ' Suas instruções
      '
      rst.MovePrevious
   Loop

Recordset – Excluir registros duplicados

Atenção:
A instrução SQL deve ordenar os registros pelo NOMEDOCAMPO

Algo semelhante à instrução abaixo:
"SELECT * FROM [NomeDaTabela] ORDER BY [NomeDoCampo]"

—- C Ó D I G O —-

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim strNome As String
    
    Set dbs = CurrentDb
    strSQL = "INSTRUÇÃOSQL" 'Veja o comentário !!!
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)

        'Se não existem registros
    If rsT.EOF Then
        Exit Sub
    End If
    
   strNome = rst!NOMEDOCAMPO
   rst.MoveNext

   Do Until rst.EOF
      If rst!NOMEDOCAMPO = strNome Then
         rst.Delete
      Else
         strNome = rst!NOMEDOCAMPO
      End If
      rst.MoveNext
   Loop

Refaz a consulta em controles de um determinado tipo

Coloque o código no procedimento de evento desejado.

Sintaxe dos tipos de controle
==============================
acTextBox -> Caixa de texto
acCheckBox -> Caixa de seleção 
acComboBox -> Caixa de combinação
acListBox -> Caixa de listagem
acCommandButton -> Botão de comando
acOptionGroup -> Grupo de opção
acSubform -> Subformulário

—- C Ó D I G O —-

    Dim ctl As Control

        ' Enumera coleção Controls.
    For Each ctl In Me.Controls
            
            ' Abaixo, trocar o tipo de controle conforme o desejado (No ex. acComboBox)
        If ctl.ControlType = acComboBox Then
                
                ' Reconsulta o controle
            With ctl
                .Requery
            End With

        End If

    Next ctl

Referir-se a um controle dentro de um controle guia

'Coloca o foco na guia
'Refere-se ao controle

—- C Ó D I G O —-

    Me.NOMEDAGUIA.Pages(INDICEDAGUIA).SetFocus
    
    Me.Controls!NOMEDOCONTROLEDENTRODAGUIA.SetFocus

Salvar registro se um campo foi modificado

Se você fizer alguma alteração em um campo do seu formulário, o
valor da propriedade Dirty passa de Falso para Verdadeiro.

Use a instrução abaixo para forçar que o registro atual seja salvo
se o valor da propriedade Dirty (Sujo) for "Verdadeiro".

—- C Ó D I G O —-

If Me.Dirty Then Me.Dirty = False

Sintaxe Forms / SubForms / SubSubForms

Modos equivalentes para sintaxe de controles em formulários e subformulários

Nomes : 
Formulário : Principal
SubFormulário : SubF
Sub-SubForm : SubSubF
Controle : NomeDoControle

—- C Ó D I G O —-

Controle no formulário
    
    • Literal
        Sintaxe : Forms!Principal!NomeDoControle
    
    • Parenteses - nomeada
        Sintaxe : Forms("Principal")("NomeDoControle")
    
    • Parenteses - variáveis
        Dim NMForm as String
        Dim NMControle as String
        NMForm = "Principal"
        NMControle = "NomeDoControle"
        
        Sintaxe : Forms(NMForm)(NMControle)
         
Controle no subformulário

    • Literal
        Sintaxe : Forms!Principal!SubF.Form!NomeDoControle
    
    • Parenteses - nomeada
        Sintaxe : Forms("Principal")("SubF").Form("NomeDoControle")
    
    • Parenteses - variáveis
        Dim NMForm as String
        Dim NMSubF as String
        Dim NMControle as String
        NMForm = "Principal"
        NMSubF = "SubF"
        NMControle = "NomeDoControle"
        
        Sintaxe : Forms(NMForm)(NMSubF).Form(NMControle)
        
Controle no sub-subformulário

    • Literal
        Sintaxe : Forms!Principal!SubF.Form!SubSubF.Form!NomeDoControle
    
    • Parenteses - nomeada
        Sintaxe : Forms("Principal")("SubF").Form("SubSubF").Form("NomeDoControle") 
    
    • Parenteses - variáveis
        Dim NMForm as String
        Dim NMSubF as String
        Dim NMSubSubF as String
        Dim NMControle as String
        NMForm = "Principal"
        NMSubF = "SubF"
        NMSubSub = "SubSubF"
        NMControle = "NomeDoControle"
        
        Sintaxe : Forms(NMForm)(NMSubF).Form(NMSubSubF).Form(NMControle)

Tabela – Excluir

Exclui uma tabela do seu banco de dados

Substitua no código:  NOMEDATABELA pelo nome da sua tabela

—- C Ó D I G O —-

Sub ExcluiTabela()
    Dim obj As AccessObject
    For Each obj In Application.CurrentData.AllTables
    
        If obj.Name = "NOMEDATABELA" Then
            
            If obj.IsLoaded Then
                DoCmd.Close acTable, "NOMEDATABELA", acSaveNo
            End If

            DoCmd.DeleteObject acTable, "NOMEDATABELA"
        End If

    Next obj

End Sub

Verificar se um campo não tem conteúdo

Algumas vezes não sabemos se um campo sem conteúdo está vazio ou é nulo.
Para não ter que testar as duas hipóteses, use a instrução abaixo.

—- C Ó D I G O —-

    If Nz(Len(Me.NOMEDOCAMPO)) = 0 Then
        'Suas instruções se o campo não tem conteúdo ...
    Else
        'Suas instruções se o campo está preenchido ...
    Endif

4 Responses to Access – Biblioteca de códigos VBA

Helio says:

29/09/2014 às 19:44

Parabéns para o autor pela “peróla” ótima referencia para os amantes do VBA

Responder
FLAVIO RANGEL says:

05/12/2014 às 20:27

Boa noite! Ótimas dicas. Estou construindo um BD para controle de despesas de um caminhão. Não consegui calcular o KM RODADO, que seria a diferença entre a KM atual menos a próxima KM. Poderia ajudar-me?

Responder
João says:

27/11/2016 às 12:11

Boa tarde. Gostei imenso de todos códigos, porque pude melhorar o meu sistema no Access. No DateSerial onde preciso mesmo da vossa ajuda. Para criar Licença no sistema. Tenho três tabelas q são Uma p contar os dias, outra p as chaves. Quero q o sistema espire de seis em seis meses. Podem me dar algumas dicas via meu email?. Agradeceria bastante. Obrigado.

Responder
Isac says:

17/05/2019 às 6:03

Boa noite! Ótimas dicas. Estou construindo um BD para controle de despesas de uma maquina copiadora. Não consegui calcular o número total copias tiradas, que seria a diferença entre o numero de leitura do registo atual menos o número de leitura do registo anterior. Poderia ajudar-me?

Responder

Access – Biblioteca de códigos VBA

Compartilhar:

4 Responses to Access – Biblioteca de códigos VBA

Deixe um comentário Cancelar resposta

Mais Acessados

Tags