VBA - Cadastrando clientes e enviando emails

VBA - Cadastro de Clientes com envio de Email no Excel - II

Na primeira parte deste artigo eu deixei tudo pronto para que nesta segunda parte pudesse partir para a definição do código VBA da aplicação.

E assim será feito...

Vamos abrir o Microsoft Excel 2007 e em seguida abrir o arquivo que criamos na primeira parte chamado: CadastroClientes

Estando na planilha aberta pressione Alt+F11 ou clique na opção Visual Basic no menu da planilha para abrir o Editor Visual Basic;

Quando a janela do Editor Visual Basic estiver aberta expanda o item Formulário e clique no formulário frmCadastroClientes para exibir o formulário conforme a figura abaixo:

Antes de definir qualquer código no formulário temos que logo no início do mesmo declarar as variáveis que iremos usar no formulário. Dessa forma no início do código do formulário digite o código que declara essas variáveis conforme abaixo:

Option Explicit
'define constantes para controlar as colunas de dados
Const colCodigo As Integer = 1
Const colNome As Integer = 2
Const colEndereco As Integer = 3
Const colCidade As Integer = 4
Const colEstado As Integer = 5
Const colCep As Integer = 6
Const colTelefone As Integer = 7
Const colEmail As Integer = 8
Const indiceMinimo As Byte = 2

'define variavies para controlar a
Private alterar As Boolean
Private novo As Boolean
Private excluir As Boolean

'define as constantes para as cores do textbox
Const corDesabilitaTextBox As Long = -2147483633
Const corHabilitaTextBox As Long = -2147483643

'define a planilha usada e o indice do registro
Private wsCadastroClientes As Worksheet
Private indiceRegistro As Long

Antes de partirmos para a definição do código dos eventos dos botões temos que definir o código que usaremos quando o formulário for aberto. Quando o formulário é aberto ocorre o evento Initialize() do formulário e nele incluímos o seguinte código:

Private Sub UserForm_Initialize()
   novo = False
   alterar = False
   excluir = False
   Set wsCadastroClientes = ThisWorkbook.Worksheets("Clientes")
   Call HabilitaBotoesAlteracao
   Call carregaDados
   Call DesabilitaControles
End Sub

A seguir vou mostrar as 4 rotinas usadas na carga do formulário: HabilitaBotoesAlteracao, carregaDados e DesabilitaControles e HabilitaControles:

1- HabilitaBotoesAlteracao - Esta rotina apenas desabilita o botões Alterar, Excluir, Novo, OK e Cancelar;

Private Sub HabilitaBotoesAlteracao()
'habilita os botões de alteração
cmdAlterar.Enabled = True
cmdExcluir.Enabled = True
cmdNovo.Enabled = True
cmdOk.Enabled = False
cmdCancelar.Enabled = False
End Sub

2- carregaDados() - Carrega os dados o registro atual exibindo-os nos controles TextBox;

Private Sub CarregaRegistro()
   'carrega os dados do primeiro registro
   With wsCadastroClientes
      If Not IsEmpty(.Cells(indiceRegistro, colNome)) Then
        Me.txtCodigo.Text = .Cells(indiceRegistro, colCodigo).Value
        Me.txtNome.Text = .Cells(indiceRegistro, colNome).Value
        Me.txtEndereco.Text = .Cells(indiceRegistro, colEndereco).Value
        Me.txtCidade.Text = .Cells(indiceRegistro, colCidade).Value
        Me.txtEstado.Text = .Cells(indiceRegistro, colEstado).Value
        Me.txtCep.Text = .Cells(indiceRegistro, colCep).Value
        Me.txtTelefone.Text = .Cells(indiceRegistro, colTelefone).Value
        Me.txtEmail.Text = .Cells(indiceRegistro, colEmail).Value
      End If
End With

Call AtualizaRegistroAtual
End Sub

3- DesabilitaControles - Desabilita os controles TextBox e altera a cor de cada um deles;

Private Sub DesabilitaControles()
   Me.txtNome.Locked = True
   Me.txtEndereco.Locked = True
   Me.txtCidade.Locked = True
   Me.txtEstado.Locked = True
   Me.txtCep.Locked = True
   Me.txtTelefone.Locked = True
   Me.txtEmail.Locked = True
    'altera a cor dos controles
   Me.txtNome.BackColor = corDesabilitaTextBox
   Me.txtEndereco.BackColor = corDesabilitaTextBox
   Me.txtCidade.BackColor = corDesabilitaTextBox
   Me.txtEstado.BackColor = corDesabilitaTextBox
   Me.txtCep.BackColor = corDesabilitaTextBox
   Me.txtTelefone.BackColor = corDesabilitaTextBox
   Me.txtEmail.BackColor = corDesabilitaTextBox
End Sub

4- HabilitaControles() : Reabilita os controles TextBox e as cores;

Private Sub HabilitaControles()
Me.txtNome.Locked = False
Me.txtEndereco.Locked = False
Me.txtCidade.Locked = False
Me.txtEstado.Locked = False
Me.txtCep.Locked = False
Me.txtTelefone.Locked = False
Me.txtEmail.Locked = False
'altera a cor dos controles
Me.txtNome.BackColor = corHabilitaTextBox
Me.txtEndereco.BackColor = corHabilitaTextBox
Me.txtCidade.BackColor = corHabilitaTextBox
Me.txtEstado.BackColor = corHabilitaTextBox
Me.txtCep.BackColor = corHabilitaTextBox
Me.txtTelefone.BackColor = corHabilitaTextBox
Me.txtEmail.BackColor = corHabilitaTextBox
End Sub

Após isso agora vamos usar o evento Click de cada um dos Botões de comando existentes no formulário para realizar as operações que desejamos que seja executada na planilha.

Basta clicar duas vezes sobre o botão desejado para que a janela de código seja aberta com o evento pronto para receber o código. Faremos este procedimento para cada uma dos 10 botões de comando iniciando com o botão Novo e deixando por último o botão Enviar Email;

1- Código dos botões que realiza as operações de manutenção de dados:

1- Botão Novo - defina a variável novo como True , limpa e habilita os controles e desabilita os controles das operações CRUD;

Private Sub cmdNovo_Click()
novo = True
excluir = False
alterar = False
Call LimpaControles
Call HabilitaControles
Call DesabilitaBotoesAlteracao
'dá o foco ao primeiro controle de dados
txtNome.SetFocus
End Sub

2- Botão Alterar: Define a variável alterar como True e verifica se o código do cliente foi informado, definindo o foco na caixa de texto Nome:

Private Sub cmdAlterar_Click()
alterar = True
If txtCodigo.Text <> vbNullString And txtCodigo.Text <> "" Then
     Call HabilitaControles
     Call DesabilitaBotoesAlteracao
     'dá o foco ao primeiro controle de dados
     txtNome.SetFocus
Else
      lblMensagem.Caption = "Não há registro a ser alterado"
End If
End Sub

3- Botão Excluir - Define a variável excluir como True , verifica se o código do cliente foi informado e desabilita os botões de alteração:

Private Sub cmdExcluir_Click()
excluir = True
If txtCodigo.Text <> vbNullString And txtCodigo.Text <> "" Then
     Call DesabilitaBotoesAlteracao
     lblMensagem.Caption = "Você confirma a exclusão deste registro. (Para excluir clique no botão OK.) "
Else
     lblMensagem.Caption = "Não existe registro a ser excluído"
End If
End Sub

4- Botão OK - Este código irá realizar as operações conforme o valor da variável alterar, nome e excluir:

Private Sub cmdOk_Click()

'valida campos do formulário
If ValidaCamposFormulario = False Then
    Exit Sub
End If

Dim proximoId As Long

'Alterar registros
If alterar = True Then
   Call SalvaRegistro(CLng(txtCodigo.Text), indiceRegistro)
   lblMensagem.Caption = "O Registro alterado com sucesso."
   alterar = False
End If

'Novo registro
If novo = True Then
proximoId = ObterProximoId
'pega a próxima linha
Dim proximoIndice As Long
   proximoIndice = wsCadastroClientes.UsedRange.Rows.Count + 1
   Call SalvaRegistro(proximoId, proximoIndice)
   txtCodigo = proximoId
   lblMensagem.Caption = "Novo registro salvo com sucesso."
   novo = False
End If

'Excluir um registro
If excluir = True Then
   Dim resultado As VbMsgBoxResult
   resultado = MsgBox("Deseja excluir o registro nº " & txtCodigo.Text & " ?", vbYesNo, "Confirmação")

If resultado = vbYes Then
   wsCadastroClientes.Range(wsCadastroClientes.Cells(indiceRegistro, colCodigo), wsCadastroClientes.Cells(indiceRegistro, colCodigo)).EntireRow.Delete
   Call carregaDados
   lblMensagem.Caption = "O Registro escolhido foi excluído com sucesso."
End If
excluir = False
End If

Call HabilitaBotoesAlteracao
Call DesabilitaControles
End Sub

5- Botão Cancelar - Cancela uma operação em andamento.

Private Sub cmdCancelar_Click()
cmdOk.Enabled = False
cmdCancelar.Enabled = False
Call DesabilitaControles
Call carregaDados
Call HabilitaBotoesAlteracao
End Sub

As operações de cada um dos botões acima descritos usam as seguintes rotinas para realizar as tarefas pertinentes:

1- SalvaRegistro() - Salva as informações na planilha Excel:

Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)
   With wsCadastroClientes
       .Cells(indice, colCodigo).Value = id
       .Cells(indice, colNome).Value = Me.txtNome.Text
       .Cells(indice, colEndereco).Value = Me.txtEndereco.Text
       .Cells(indice, colCidade).Value = Me.txtCidade.Text
       .Cells(indice, colEstado).Value = Me.txtEstado.Text
       .Cells(indice, colCep).Value = Me.txtCep.Text
       .Cells(indice, colTelefone).Value = Me.txtTelefone.Text
       .Cells(indice, colEmail).Value = Me.txtEmail.Text
End With

Call AtualizaRegistroAtual
End Sub

2- ObterProximoId - Obtém a próxima posição do registro na planilha:

Private Function ObterProximoId() As Long
   Dim rangeIds As Range
   'pega o range que se refere a toda a coluna do código (id)
   Set rangeIds = wsCadastroClientes.Range(wsCadastroClientes.Cells(indiceMinimo, colCodigo), wsCadastroClientes.Cells(wsCadastroClientes.UsedRange.Rows.Count, colCodigo))
   ObterProximoId = WorksheetFunction.Max(rangeIds) + 1
End Function

3- AtualizaRegistroAtual - Atualiza a informação do registro atual exibindo a posição atual do registro na Label do formulário:

Private Sub AtualizaRegistroAtual()
lblRegistro.Caption = indiceRegistro - 1 & " de " & wsCadastroClientes.UsedRange.Rows.Count - 1
End Sub

2- Código dos botões que permitem a navegação pelos dados da planilha

1- << - Primeiro Registro : Limpa a mensagem e verifica o índice do registro posicionando-o no primeiro registro;

Private Sub cmdPrimeiro_Click()
Call limpaMensagem
indiceRegistro = indiceMinimo
If indiceRegistro > 1 Then
Call CarregaRegistro
End If
End Sub

2- < - Registro Anterior - Limpa a mensagem e verifica o índice do registro posicionando-o no registro anterior;

Private Sub cmdAnterior_Click()
If indiceRegistro > indiceMinimo Then
indiceRegistro = indiceRegistro - 1
End If
If indiceRegistro > 1 Then
Call CarregaRegistro
End If
End Sub

3- > - Próximo Registro - Limpa a mensagem e verifica se o índice do registro e menor que o total de linhas; posicionando-o no próximo registro;

Private Sub cmdProximo_Click()
Call limpaMensagem
If indiceRegistro < wsCadastroClientes.UsedRange.Rows.Count Then
indiceRegistro = indiceRegistro + 1
End If
If indiceRegistro > 1 Then
Call CarregaRegistro
End If
End Sub

4- >> - Último Registro - Limpa a mensagem e atribui o total de registro ao índice indo para último registro:

Private Sub cmdUltimo_Click()
   Call limpaMensagem
   indiceRegistro = wsCadastroClientes.UsedRange.Rows.Count
   If indiceRegistro > 1 Then
     Call CarregaRegistro
   End If
End Sub

3- Código do botão Enviar Email

Private Sub cmdEnviaEmail_Click()

Dim aplicacaoOutlook As Object
Dim OutLookMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set aplicacaoOutlook = CreateObject("Outlook.Application")

On Error GoTo limpa

Set OutMail = aplicacaoOutlook.CreateItem(0)

On Error Resume Next

With OutLookMail
   .Subject = "Aviso"
   .Body = "Caro " & txtNome.Text _
    & vbNewLine & vbNewLine & _
   "Entre em contato com nosso serviço de cobrança " & _
   "para tratar assunto de seu interesse com urgência"
   'Podemos enviar um anexo
   .Attachments.Add ("c:\dados\carta.txt")
   .Send
End With

On Error GoTo 0
   Set OutLookMail = Nothing
   MsgBox ("Email enviado com sucesso..." & " para " & txtEmail.Text)

limpa:
    Set aplicacaoOutlook = Nothing
    Application.ScreenUpdating = True
End Sub

A rotina para enviar um email usa o Microsoft OutLook criando uma instância deste objeto e montando e enviando um email.

4- Rotinas de validação de dados usadas no formulário

- ValidaCamposFormulario() - Valida os campos do formulário antes de gravar;

Private Function ValidaCamposFormulario() As Boolean

If Me.txtNome.Value = "" Then
   Me.txtNome.SetFocus
   MsgBox " 'Nome' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
   ValidaCamposFormulario = False
   Exit Function
ElseIf Me.txtEndereco.Value = "" Then
   Me.txtEndereco.SetFocus
   MsgBox " 'Endereço' é um campo obrigatório.", vbOKOnly, " Campo Obrigatório "
   ValidaCamposFormulario = False
   Exit Function
ElseIf Me.txtCidade.Value = "" Then
   Me.txtCidade.SetFocus
   MsgBox "'Cidade' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
   ValidaCamposFormulario = False
   Exit Function
ElseIf Me.txtEstado.Value = "" Then
   Me.txtCidade.SetFocus
   MsgBox "'Estado' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
   ValidaCamposFormulario = False
   Exit Function
ElseIf Me.txtCep.Value = "" Then
   Me.txtCep.SetFocus
   MsgBox " 'Cep' é um campo obrigatório. ", vbOKOnly, " Campo Obrigatório "
   ValidaCamposFormulario = False
   Exit Function
ElseIf Me.txtTelefone.Value = "" Then
   Me.txtTelefone.SetFocus
   MsgBox "'Telefone' é um campo obrigatório.", vbOKOnly, " Campo Obrigatório "
   ValidaCamposFormulario = False
   Exit Function
ElseIf Me.txtEmail.Value = "" Then
   Me.txtEmail.SetFocus
   MsgBox "'Email' é um campo obrigatório.", vbOKOnly, " Campo Obrigatório "
   ValidaCamposFormulario = False
   Exit Function
End If
ValidaCamposFormulario = True
End Function

Validação do Email informado no campo Email usando uma expressão regular:

Private Sub txtEmail_Exit(ByVal Cancel As MSForms.ReturnBoolean)

   With CreateObject("vbscript.regexp")
   .Pattern = "^[\w-\.]+@([\w-]+\.)+[A-Za-z]{2,3}$"
   If Not .test(txtEmail.Value) Then
      MsgBox "Email inválido."
      Cancel = True
   End If
End With

End Sub

Ao executarmos o projeto abrindo a planilha Excel ao clicarmos no botão para enviar um email para o cliente selecionado iremos obter:

Simples, simples assim...

Pegue o projeto completo aqui: CadastroClientesVBAExcel.zip

Eu sei é apenas Visual Basic for Applications (VBA), mas eu gosto...

Veja os Destaques e novidades do SUPER DVD Visual Basic (sempre atualizado) : clique e confira !

Quer migrar para o VB .NET ?

Veja mais sistemas completos para a plataforma .NET no Super DVD .NET , confira...
Curso Básico VB .NET - Vídeo Aulas

Quer aprender C# ??

Chegou o Super DVD C# com exclusivo material de suporte e vídeo aulas com curso básico sobre C#.
Curso C# Basico - Video Aulas

Gostou ? Compartilhe no Facebook Compartilhe no Twitter

Referências:

José Carlos Macoratti