Views

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



































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
Tags: , , , , , , , ,

Nenhum comentário:

Postar um comentário

Assinar: Postar comentários (Atom)
diHITT - Notícias