[Resolvido]Parar função gravar se mensagem não for enviada

olá bom dia todos:

1tenho um botao "bravar" para adicionar registro de usuarios novos (do sistema)
onde suas senhas são randomizada e enviadas por email.
2-depois de tudo pronto percebi que o usuario e gerado mesmo quando há falha no envio da mensagem
com isso ele fica sem saber a senha.. (ninguem sabe a senha)
3- Gostaria que a rotina parasse se a função mandar email apresentasse error
e com isso não criar um novo registro de usuario.
4- só criar registro se mandar o email primeiro:

obrigado, segue o código

Código:

Private Sub btgravar_Click()
Dim rsUsuários      As DAO.Recordset
Dim rsFunções      As DAO.Recordset
Dim rsPermissões    As DAO.Recordset
Dim strFiltro      As String
Dim strSQL          As String
Dim blnNovo        As Boolean
Dim idu            As Long
Dim strSenha        As String
Dim k              As Byte

'----------------CONDIÇÕES PARA CRIAR NOVO USUARIO''''''
'----------------------------------------------------------------

On Error Resume Next
'ver se combo matricula esta vazia
If Me.ListaCombo.Value = "" Or IsNull(Me.ListaCombo) Then
MsgBox "Digite a matricula para prosseguir", vbExclamation, "Controle de Usuario"
Me.ListaCombo.SetFocus
Exit Sub
End If
    ' ver se registro de usuario já existe
 
    If DCount("MatriculaUsuario", "tblUsuários", "MatriculaUsuario = " & Me.txmatriculafuncionario & "") > 0 Then
    MsgBox "" & Me.tx1 & " já é usuário do sistema", vbInformation, "Controle de Usuarios"
    Exit Sub
    End If
  ' ver se email está vazio
      If Me.txt_EmailFuncionario = "" Then
  MsgBox "Não é possivel registrar " & Me.tx1 & " como usuario do sistema, no momento, porque ele não possui E-mail cadastrado. Necessário informa-lo, para que ele possa solicitar o registro com o Setor de registro de funcionario ", vbExclamation, "Controle de Usuario"
Exit Sub
End If

          'confirmar regisrtro
    If MsgBox("Confirma o registro de " & Me.tx1 & "? a ser encaminhado para o E-mail " & Me.txt_EmailFuncionario & " ", vbQuestion + vbYesNo, "Controle de Usuario") = vbNo Then
Exit Sub
End If
'------------------------------------------------------------
'CONDICÕES PARA ENVIAR EMAIL
'--------------------------------------------------------------

Dim Mens As CDO.Message
Dim Config As CDO.Configuration
On Error GoTo erromail

Set Config = New CDO.Configuration

With Config

.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'seu servidor de e-mail
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 ' porta usada pelo seu servidor de e-mail
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = ParametrosSistema.email  'user do servidor
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "1A2B3C4D" 'coloque a senha do seu email
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update
End With
'---------------------------------------
Set Mens = New CDO.Message

With Mens

Set .Configuration = Config
.From = "Sistemas Visão Digital" 'quem envia
.Sender = ParametrosSistema.email  'email transmissor. ta baseado na varivel global (parametrossistema)
'.BCC = '"EMAILOCULTO"
.Subject = " Senha de Acesso " 'caixa texto assunto
.TextBody = "Senha " & Me.tx2 & " foi criada aleatoriamente e criptografada. Para acesso ao sistema digite sua matricula funcional (Usuario) e esta senha. Se quiser mudar a senha e /ou usuario vá na tela principal clique em MUDAR SENHA/USUARIO" 'Caixa texto com o texto"
.To = Me.txt_EmailFuncionario  ' email receptor
.Send ' envia

 End With
 Set Mens = Nothing
Set Config = Nothing

'Exit Sub

'-----------------
'fim  da email
'-----------------


'erromail:
'MsgBox Err.Number & " " & Err.Description
'Set Mens = Nothing
'Set Config = Nothing


  '------------------------------------------------------
    'PARA METROS PARA CRIAR CRIA NOVO USUARIO<<<<<<<<<
    '--------------------------------------------------
    Set rsUsuários = CurrentDb.OpenRecordset("tblUsuários")
    rsUsuários.AddNew
   
    idu = rsUsuários!idusuario
    blnNovo = True
           
rsUsuários!usuario = Me.txmatriculafuncionario
rsUsuários!senha = IIf(Len(Me!tx3 & "") > 0, fncCrip(Me!tx3, 102030), fncCrip(Me!tx2, 102030))
rsUsuários!bloqueado = 0
rsUsuários!MatriculaUsuario = Me.txmatriculafuncionario
rsUsuários!Status = "Novo"
rsUsuários!nomefuncionario = Me.tx1
rsUsuários!idfuncionario = Me.ListaCombo.Column(0)
rsUsuários!numerodeacesso = 0
rsUsuários.Update
rsUsuários.Close
DoCmd.Requery

Set rsUsuários = Nothing

'Exit Sub

'-----PARAMETROS PARA CRIAR PERMISSÕES PARA O UUSARIOS---------------
'---------------------------------------------------------------------

'Call fncCarregalista(Me.OpenArgs, Val(Me.OpenArgs) = 0)
'If Val(Me.OpenArgs) > 1 Then
'End If 'MsgBox "Foi criado um usuario para " & Me.tx1 & " com sucesso! Informar que o 1º acesso ao sistema deverá digitar a matricula funcional e a senha que está no email. ", vbInformation, "Aviso"
If blnNovo = True Then
    Set rsPermissões = CurrentDb.OpenRecordset("tblPermissõesUsuários")
    Set rsFunções = CurrentDb.OpenRecordset("tblFunções")
    rsFunções.MoveFirst
    Do While Not rsFunções.EOF
        rsPermissões.AddNew
            rsPermissões!idusuario = idu
            rsPermissões!IdFuncao = rsFunções!IdFuncao
            rsPermissões!Atualizar = -1
            rsPermissões!Inserir = -1
            rsPermissões!Excluir = -1
            rsPermissões!Impressao = -1
            rsPermissões!Grafico = -1
            rsPermissões!Bloqueada = 0
        rsPermissões.Update
              rsFunções.MoveNext
        DoCmd.Requery
    Loop
    rsFunções.Close
    rsPermissões.Close
    Set rsFunções = Nothing
    Set rsPermissões = Nothing
    DoCmd.Requery
   
  End If



Set Mens = Nothing
Set Config = Nothing

MsgBox "Registro de Usuario feito com sucesso, senha enviada para o email: " & Me.txt_EmailFuncionario & " de " & Me.tx1 & "", vbInformation, "Controle de Usuarios"

'---------------------------
'----AQUI TRATA O ERRO------
'---------------------------

Exit Sub
erromail:
If Nz(Err.Number) Then
MsgBox Err.Description
Set Mens = Nothing
Set Config = Nothing
End If

Call fncLimpaCampos
Exit Sub
DoCmd.Requery
End Sub


MODIFIQUEI O CODIGO.