VBA Excel - Enviando mais de uma planilhas por eMail - Mail more then one sheet with SendMail

|Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

DESENVOLVO APLICAÇÕES VBA

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba  3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Você tem direito as informações da sua empresa

Podemos usar o código desta página para trabalhar com o Outlook, Outlook Express, Windows Mail e Windows Live Mail.

É importante lembrar que ao usar o método SendMail não será possível:

1) Enviar texto no corpo do e-mail

2) Usar o campo CC ou BCC

3) Anexar outros arquivos

Se quiser ter as opções acima e estiver usando o Outlook, poderá usar outro exemplo de modelo de objeto do Outlook.

A sub-rotina a seguir envia uma planilha com as pastas na Matriz:

.Sheets(Array("Plan1", "Plan3")).Copy

Use isto se você quiser enviar as planilhas selecionadas:

TheActiveWindow.SelectedSheets.Copy

É salvando a planilha antes de enviá-la com um carimbo de data / hora.

Depois que o arquivo for enviado para a pasta de trabalho será excluído do seu disco rígido.

Altere o endereço de e-mail e o assunto na macro antes de executá-la.

Nota: se você usar o Windows Live Mail o endereço deverá constar nos seus contatos.

Sub MailSheetsArray()

    ' Funciona nas versões 97-2010

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim Sourcewb As Workbook

    Dim Destwb As Workbook

    Dim TempFilePath As String

    Dim TempFileName As String

    Dim sh As Worksheet

    Dim TheActiveWindow As Window

    Dim TempWindow As Window

    Dim I As Long

    With Application

        Let .ScreenUpdating = False

        Let .EnableEvents = False

    End With

    Set Sourcewb = ActiveWorkbook

    ' Copia a planilha para um novo workbook.

    ' Adicionamos uma janela temporária para evitar o problema de cópia.

    ' Se houver uma lista ou tabela numa das sheets e as sheets se agrupem caso exista uma lista ou tabela em uma das folhas.

    With Sourcewb

        Set TheActiveWindow = ActiveWindow

        Set TempWindow = .NewWindow

        .Sheets(Array("Sheet1", "Sheet3")).Copy

    End With

    ' Fecha a janela temporária

    TempWindow.Close

    Set Destwb = ActiveWorkbook

    'Determina a versão do MS Excel e o tipo de extensão.

    With Destwb

        If Val(Application.Version) < 12 Then

            'Excel 97-2003

            Let FileExtStr = ".xls": FileFormatNum = -4143

        Else

            'Se for a versão 2007-2010 do Excel, Saímos da sub quando sua resposta for

            'NO no diálogo de segurança que você só vê quando copia

            'a planilha de um arquivo xlsm com macro estiver desativada.

            If Sourcewb.Name = .Name Then

                With Application

                    Let .ScreenUpdating = True

                    Let .EnableEvents = True

                End With

                MsgBox "Sua resposta é NO na janela de segurança."

                Exit Sub

            Else

                Select Case Sourcewb.FileFormat

                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51

                Case 52:

                    If .HasVBProject Then

                        FileExtStr = ".xlsm": FileFormatNum = 52

                    Else

                        FileExtStr = ".xlsx": FileFormatNum = 51

                    End If

                Case 56: FileExtStr = ".xls": FileFormatNum = 56

                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50

                End Select

            End If

        End If

    End With

    ' Salva a nova planilha/Envia o e-Mail/Deleta o

    Let TempFilePath = Environ$("temp") & "\"

    Let TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With Destwb

        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

        On Error Resume Next

        For I = 1 To 3

            .SendMail "bernardess@gmail.com", "Aqui está a linha de Assunto (Subject)"

            If Err.Number = 0 Then Exit For

        Next I

        On Error GoTo 0

        .Close SaveChanges:=False

    End With

    'Deleta o arquivo que foi enviado

    Kill TempFilePath & TempFileName & FileExtStr

    With Application

        Let .ScreenUpdating = True

        Let .EnableEvents = True

    End With

End Sub

Tags: VBA, Excel, e-mail, e-mail, send, sendmail,Outlook, Outlook Express, Windows Mail, Windows Live Mail