none
CONFIGURAÇÃO DE EMAIL NO OUTLOOK/EXCEL RRS feed

  • Pergunta

  •  Pessoal, O código abaixo busca dados de uma planilha Sheets("DESVIO E-MAIL SOLICITANTE"), e vai para o email automático no outlook.

    Sheets("DESVIO E-MAIL SOLICITANTE").Select
    ActiveCell = Me.TXTDESVIO
    ActiveCell.Offset(0, 1) = Me.TXTMATSOLICITADO
    ActiveCell.Offset(0, 2) = Me.TXTMATENCONTRADO
    Set myOlApp = CreateObject("Outlook.Application")
    Set myItem = myOlApp.CreateItem(olMailItem)
    Set myAttachments = myItem.Attachments
    Set Planilha = Sheets("DESVIO E-MAIL SOLICITANTE")

    Conteúdo = "ANALIZAR O DESVIO N° ->" & vbTab
    Final = "PARA SER ANALIZADO." & vbLf

    N = Planilha.Cells(Planilha.Rows.Count, 1).End(xlUp).Row
    N = Planilha.Cells(Planilha.Rows.Count, 2).End(xlUp).Row
    N = Planilha.Cells(Planilha.Rows.Count, 3).End(xlUp).Row

       For i = 1 To N
        Conteúdo = Conteúdo & Trim(Planilha.Cells(i, 1)) & vbTab & Final & vbTab
        Conteúdo = Conteúdo & Trim(Planilha.Cells(i, 2)) & vbTab & vbLf
        Conteúdo = Conteúdo & Trim(Planilha.Cells(i, 3)) & vbTab & vbLf
        Next i

    With myItem
        .To = "" 'E-mail Engenharia
        .Subject = "DESVIO PARA ANÁLISE"
        .Body = Conteúdo
        .Display
        .send
    End With

    Ocorpo do email esta desconfigurado, conforme abaixo:

    ANALIZAR O DESVIO N° -> 6542.
            656546542      
    6454544444442  

    Preciso que apareça NO EMAIL:

    ANALIZAR O DESVIO N° -> 6542. 
     MATERIAL SOLICITADO      656546542      
      MATERIAL ENCONTRADO             6454544444442  

    terça-feira, 15 de maio de 2012 17:41

Respostas

Todas as Respostas

  • Olá,

    Use esta rotina do Ron de Bruin: http://www.rondebruin.nl/mail/folder3/mail4.htm. A rotina cola um intervalo de células em formato HTML no corpo do Outlook.

    Conseguiu adaptar para seu caso?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 16 de maio de 2012 01:24
    Moderador
  • Cara,

    Negócio complicado esse Ron de Bruin. Não tive sucesso não.

    O que acontece: Tenho uma planilha para cadastro de desvios de engenharia. Os devios são criados aleatoriamente em ordem crescente por compradores.

    Meu iluminado gerente que quando os compradores, ao lançar os dados, apareça um email com todos os desvio já cadastrados de um (PN - Part Number), ou seja, se esta havendo muitos desvios para uma determinada peça. Eu tentei fazer um filtro e também uma PROCV com o valor de referencia PN, ou dois sem sucesso.

    Obrigado,

    Leonardo Oliveira.

    quarta-feira, 16 de maio de 2012 12:28
  • Quando você diz que o seu e-mail está desconfigurado, é puramente a formatação que está inadequada ou as informações que estão sendo colocadas no formulário são insuficientes?

    Teria algum modelo para disponibilizar para eu adaptar uma rotina?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 17 de maio de 2012 02:06
    Moderador
  • Felipe,

    Arquivo anexo no link: http://www.4shared.com/office/944sQtCL/SOLICITAO_DE_DESVIOS.html

    Tem um arquivo explicativo também no link: http://www.4shared.com/file/CO1w3fTi/Explicativo_desvios.html

    Espero ter explicado direito todos os detalhes.

    Grato pela atenção,

    Leonardo Oliveira.

    quinta-feira, 17 de maio de 2012 12:42
  • Leonardo,

    Tenho comentários no seu código. Não tenho como resolver o problema original que você solicitou ainda porque tem coisas muito mais importantes que você precisa consertar antes em seu projeto. Podemos fazer muitas melhorias nele.

    ---

    Em Private Sub Workbook_Open(), Substituí o código:

        Sheets(">> MENU >> DESVIOS").Select

    por

        On Error Resume Next
        Sheets(">> MENU >> DESVIOS").Select
        Sheets(">> MENU >> DESVIOS").Activate
        On Error GoTo 0
    Muitas vezes, quando se abre uma Pasta de Trabalho por e-mail ou através de um download, o método Select ou Activate retorna um erro. Para suprimir a interrupção da rotina, fiz esse pequeno tratamento de exceção. Leia mais sobre tratamento de exceção em: http://www.ambienteoffice.com.br/officevba/tratamento_de_excecao/.

    ---

    Notei que você usa exaustivamente a rotina:

        With ActiveWindow
            Application.DisplayFullScreen = True
            ActiveWindow.DisplayHeadings = False
            Application.DisplayFormulaBar = False
            ActiveWindow.DisplayHorizontalScrollBar = True
            ActiveWindow.DisplayVerticalScrollBar = True
            ActiveWindow.DisplayWorkbookTabs = False
            Application.DisplayStatusBar = False
        End With

    E usa também, a rotina contrária, para voltar a exibição da Pasta de Trabalho para o normal. Você pode economizar muitas linhas de código criando dois procedimentos chamados, por exemplo, TelaCheia e TelaNormal:

    Sub TelaCheia()
        With ActiveWindow
            Application.DisplayFullScreen = True
            ActiveWindow.DisplayHeadings = False
            Application.DisplayFormulaBar = False
            ActiveWindow.DisplayWorkbookTabs = False
            Application.DisplayStatusBar = False
        End With
    End Sub
    
    Sub TelaNormal()
        With ActiveWindow
            Application.DisplayFullScreen = False
            ActiveWindow.DisplayHeadings = True
            Application.DisplayFormulaBar = True
            ActiveWindow.DisplayWorkbookTabs = True
            Application.DisplayStatusBar = True
        End With
    End Sub

    E então, fazer chamada a eles quando precisar:

    Sub Exemplo()
        TelaCheia
        
        '...
        'Código aqui. Chamada de formulários e outras rotinas
        '...
        
        TelaNormal
    End Sub

    Isso ajuda a manter seu código organizado. Além disso, se você quiser alterar essa etapa do código, você irá fazê-la em apenas um lugar ao invés de fazer em trechos de código. Fiz essas alterações.

    (acabei de ver que você já tinha duas rotinas aqui, chamadas OcultarContornos e ReexibirContornos, mas você não as usou em seu código)

    ---

    Você não está usando a opção Option Explicit! Esse é o erro mais grave de qualquer projeto em VBA. Leia mais em: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/.

    ---

    Percebi que você não estava usando o método Unload Me para fechar alguns formulários, ao sair. Não esqueça de utilizá-lo! Inseri os métodos nos lugares que estavam faltando.

    ---

    Em UFSENHAENTRADA, o código:

    Private Sub UserForm_QueryClose(Cancel As Integer, FECHAR As Integer)
        If FECHAR = vbFormControlMenu = True Then
            Cancel = True
        End If
    End Sub

    Por que usá-lo? Impedir um usuário de fechar uma janela quando quiser é irritante. Sugiro remoção do código.

    Eu entendo que você deve processar algumas informações antes de fechar o formulário. Nesse caso, use o código:

    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        Sair
    End Sub
    
    Private Sub CommandButton1_Click()
        'Este é o botão CANCELAR
        Unload Me
    End Sub
    
    Private Sub Sair()
        'Workbooks("SOLICITAÇÃO DE DESVIOS.xls").Close SaveChanges:=True
        Unload Me
        TelaNormal
    End Sub

    Explicação: quando você usar o método Unload Me, a rotina UserForm_QueryClose é chamada.

    ---

    ---

    Em UFSENHAENTRADA, alterei o valor da propriedade Style de 0 - fmStyleDropDownCombo para 2 - fmStyleDropDownList da Caixa de Seleção (ComboBox) cmbUsuário.

    Isso significa que apenas valores constantes na caixa de seleção podem ser selecionados e não é possível digitar nenhum texto diferente de elementos constantes nele.

    ---

    Troquei o código

    Private Function RowOf(vProcura As Variant, Optional rng As Range) As Long
        If TypeName(vProcura) = "Range" And rng Is Nothing Then
            Set rng = vProcura.EntireColumn
        End If
        With rng
            Set rng = .Find(vProcura, .Cells(1), xlValues, xlWhole, xlRows, xlNext, True)
            If Not rng Is Nothing Then
                RowOf = rng.Row
            Else
                RowOf = 0
            End If
        End With
    End Function
    

    por:

    Function EleOf(va As Variant, rng As Range) As Long
        'Retorna o valor da linha ou coluna de um elemento num vetor. Caso não seja encontrado, é retornado 0.
        On Error Resume Next
        EleOf = WorksheetFunction.Match(va, rng, 0)
    End Function

    Ele é mais simples, rápido e versátil, para você usar futuramente em seus próximos projetos.

    ---

    No código:

            MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", , "ATENÇÃO"
    

    Alterei por:

            MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", vbCritical, c_sPrograma
    

    Usei vbCritical para dar um efeito estética na caixa de mensagem e constante c_sPrograma como título. Crie um módulo chamado mdlPúblicos, que possui a definição:

    Public Const c_sPrograma As String = "Sistema Solicitação de Desvios"

    Você deve usar essa mesma construção de caixa de mensagem de erros em seu código. Dessa forma, todos os títulos de erros das caixas de mensagem serão padronizados e, se você quiser alterar o nome do título de todas, basta alterar o valor dessa constante.

    ---

    Não acho necessário você usar a instrução:

    Application.ScreenUpdating = False

    em seu projeto, neste caso. Pus as linhas em que elas aparecem de uma forma comentada, para elas não rodarem.

    ---

    O bloco de código:

        If Me.CmbUsuario = "" Then
            MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", vbCritical, "ATENÇÃO"
            CmbUsuario.SetFocus
        Else
            '...código...

    substituí por:

        If Me.CmbUsuario = "" Then
            MsgBox "NÃO DEIXE CAMPOS EM BRANCO. PREENCHA TODOS OS CAMPOS CORRETAMENTE", vbCritical, "ATENÇÃO"
            CmbUsuario.SetFocus
            Exit Sub
        End If

    Dessa forma, aninha-se menos o código e previne-se de colocar o End If, após o Else mostrado acima, num lugar errado que continue a execução de código indesejado, como vi UFSENHAENTRADA.

    ---

    Sobre a linha:

        Application.EnableCancelKey = xlDisabled
    

    Ela deve ser usada somente em condições muito restritas! Remova ela imediatamente do código.

    Se quiser saber como fazer um bom uso dela, veja: http://www.ambienteoffice.com.br/officevba/gerenciar_uso_de_ctrl_break_durante_execucao_de_codigo/.

    ---

    Pessoalmente, não gosto de colocar nomes de controles ou variáveis em letras maiúsculas. Por exemplo, os nomes TXTNOMEENTRADATXTDATAENTRADA eu substituiria por txtNomeEntrada txtDataEntrada.

    Além disso, os nomes de Planilha CONTROLE ACESSO FINALIZAÇÃO DESVIO por, respectivamente, Controle Acesso Finalização Desvio.

    A mesma coisa de formulários: UFSENHAENTRADA UFSENHAENG por frmSenhaEntrada frmSenhaEng.

    ---

    Notei que para gravar numa Planilha, você:

    1 - Torna a Planilha visível

    2 - Desprotege a Planilha

    3 - Seleciona a Planilha

    3 - Grava informações da Planilha usando propriedades como ActiveCell

    4 - Protege a Planilha

    5 - Oculta a Planilha

    Isso pode ser simplificado. Não é necessário que uma Planilha esteja visível nem que esteja selecionada para que você leia ou grave dados nela. Obviamente, ela deve estar desprotegida. Então essas etapas podem ser reduzidas para:

    1 - Desproteger a Planilha

    2 - Gravar informações da Planilha usando propriedades como Cell e Range

    3 - Proteger a Planilha.

    Se o objetivo for ler informações de uma Planilha oculta e protegida, você precisará apenas de uma etapa!

    1 - Ler informações da Planilha usando propriedades como Cell e Range

    Sim, não é necessário reexibir nem desproteger uma Planilha para ler informações dela diretamente.

    Por exemplo, o formulário UFSENHAENTRADA, antes com o código:

        'LANÇA OS DADOS NA PLANILHA DE CONTROLE
    
        'REEXIBIR PLANILHA
        Sheets("CONTROLE ACESSO").Visible = True
        'DESPROTEGE PLANILHA
        Sheets("CONTROLE ACESSO").Unprotect "123"
        Sheets("CONTROLE ACESSO").Select
    
        Sheets("CONTROLE ACESSO").Select
        Range("A60000").End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        ActiveCell = Me.CmbUsuario
        ActiveCell.Offset(0, 1) = Me.TXTNOMEENTRADA
        ActiveCell.Offset(0, 2) = Me.TXTDATAENTRADA
    
        'PROTEGE PLANILHA
        ActiveWorkbook.Unprotect "123"
        Sheets("CONTROLE ACESSO").Protect "123", True, True, True
        'OCULTA PLANILHA
        Sheets("CONTROLE ACESSO").Select
        ActiveWindow.SelectedSheets.Visible = False
    
        TelaCheia
        
        'REEXIBIR PLANILHA
        Sheets("Dados").Visible = True
        'DESPROTEGE PLANILHA
        Sheets("Dados").Unprotect "123"
        Sheets("Dados").Select
    
        'Application.ScreenUpdating = False
        'Application.EnableCancelKey = xlDisabled
    
        Dim Nome
        Dim Linha
        Nome = CmbUsuario
        Linha = Me.CmbUsuario.ListIndex
    
        ActiveWorkbook.Unprotect "123"
        Sheets("Dados").Visible = True
        Sheets("Dados").Select
        Range("A2").Offset(Linha, 2).Select
        ActiveCell = TxtSenha.Value
    
        If ActiveCell <> ActiveCell.Offset(0, -1) Then
            MsgBox "Senha Inválida", , "Aviso"
            Me.TxtSenha.Value = ""
            Me.TxtSenha.SetFocus
            Exit Sub
    
        Else
    
            Sheets("Dados").Visible = True
            ActiveWorkbook.Protect "123"
            Sheets("dados").Select
    
            'PROTEGE PLANILHA
            ActiveWorkbook.Unprotect "123"
            Sheets("Dados").Protect "123", True, True, True
            'OCULTA PLANILHA
            Sheets("Dados").Select
            ActiveWindow.SelectedSheets.Visible = False
    
        End If
    
        Sheets(">> MENU >> DESVIOS").Select
    

    Fica com o código bem mais enxuto:

    Private Sub btnOK_Click()
    
        Dim lRow As Long
        
        If cmbDepartamento = "" Then
            MsgBox "Selecione um Departamento!", vbCritical, c_sPrograma
            cmbDepartamento.SetFocus
            Exit Sub
        End If
        With Sheets("Dados")
            lRow = EleOf(cmbDepartamento, .Columns("A"))
            If txtSenha <> .Cells(lRow, "B") Then
                MsgBox "Senha incorreta!", vbCritical, c_sPrograma
                Exit Sub
            End If
        End With
    
        'Lança os dados na Planilha CONTROLE ACESSO:
        With Sheets("CONTROLE ACESSO")
            .Unprotect "123"
            lRow = RowLast(.Columns("A")) + 1
            .Cells(lRow, "A") = cmbDepartamento
            .Cells(lRow, "B") = txtNomeEntrada
            .Cells(lRow, "C") = txtDataEntrada
            .Protect "123"
        End With
    
        Unload Me
    End Sub

    Sugiro que você estude e entenda muito bem o código acima.

    Note que criei uma função chamada RowLast, que retorna a última linha populada de uma coluna. Ela se num módulo chamado mdlComuns junto com a função EleOf, citada acima.

    Veja como está o arquivo modificado: https://skydrive.live.com/redir?resid=FB206A2D510E0661!373.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sábado, 19 de maio de 2012 17:22
    Moderador
  • Felipe,

    Não estou conseguindo baixar o arquivo que você modificou...

    Muito obrigado pelas dicas. Fique certo de que vou me esforçar para melhorar.

    Muito obigado,

    Leonardo Oliveira.

    segunda-feira, 21 de maio de 2012 11:31
  • Olá,

    Você não deve estar conseguindo entrar no link pq eu pus um ponto final após o URL. Experimente removê-lo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 21 de maio de 2012 12:06
    Moderador
  • A extenção do arquivo esta diferente:

    Não consigo abrir.

    segunda-feira, 21 de maio de 2012 12:49
  • A extenção do arquivo esta diferente:

    Não consigo abrir.

    segunda-feira, 21 de maio de 2012 12:49
  • Esse arquivo está em extensão rar, semelhante ao zip. Pus nesse formato porque a Pasta de Trabalho é grande, tem 4 mega.

    Tente esse link: https://skydrive.live.com/redir?resid=FB206A2D510E0661!374


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 21 de maio de 2012 22:40
    Moderador
  • Muito obrigado Felipe,

    Eu vi que o arquivo era rar., pois no computador da empresa só adm. para instalar os programas.

    Vou dar uma olhada e fazer as modificações no documento original.

    Obrigado pelo apoio.

    Leonardo

    terça-feira, 22 de maio de 2012 11:16