Solucionado (ver solução)
Solucionado
(ver solução)
1
resposta

Como enviar um separador do EXCEL como anexo

Construi o seguinte código, baseado no que aprendemos em aula, para disparar um e-mail automático de faturação semanal para minha empresa. No entanto, era mais interessante para mim enviar os separadores como anexos do que como textos no corpo do e-mail. Saberiam me auxiliar em como deve ser feita a construção do código? Teria de enviar 2 anexos:

Sub sbEmailIc()

Dim oOutlook As Object
Dim oEmail As MailItem

Set oOutlook = CreateObject("Outlook.Application")
Set oEmail = oOutlook.CreateItem(olMailItem)

oEmail.To = "administracao@okis360.pt"
oEmail.cc = "psilveira@okis360.pt" & "aamaral@okis360.pt" & "operacoes@okis360.pt"
oEmail.Subject = "Faturação Semanal IC de " & Sheets("Auxiliar E-mail").Range("B2") & "até " & Sheets("Auxiliar E-mail").Range("D2")
oEmail.Body = fnMontaCorpoEmail
oEmail.Save

MsgBox ("E-mail enviado")

Set oOutlook = Nothing
Set oEmail = Nothing

End Sub

Private Function fnMontaListaReturns()

Dim ContaLinhas As Long
Dim auxRetorno As String

ContaLinhas = 2
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 1)) & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 2)) & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 3)) & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 4)) & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 6)) & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 7)) & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 8)) & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(1, 9)) & vbTab
auxRetorno = auxRetorno & fnPulaLinha()

Do While Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 1)) <> vbNullString
    If Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 10)) = vbNullString Then

        auxRetorno = auxRetorno & Left(Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 1)), 6) & vbTab & vbTab
        auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 2)) & vbTab
        auxRetorno = auxRetorno & Format(Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 3)), "dd/mm/yyyy") & vbTab
        auxRetorno = auxRetorno & Format(Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 4)), "dd/mm/yyyy") & vbTab
        auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 6)) & vbTab
        auxRetorno = auxRetorno & Format(Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 7)), "€ ##.00") & vbTab
        auxRetorno = auxRetorno & Format(Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 8)), "00") & vbTab
        auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Novo").Cells(ContaLinhas, 9)) & vbTab
        auxRetorno = auxRetorno & fnPulaLinha()

    End If

    ContaLinhas = ContaLinhas + 1

Loop

fnMontaListaReturns = auxRetorno

End Function

Private Function fnMontaListaDanos()

Dim ContaLinhas As Long
Dim auxRetorno As String

ContaLinhas = 2
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(1, 1)) & vbTab & vbTab & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(1, 3)) & vbTab & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(1, 6)) & vbTab & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(1, 7)) & vbTab & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(1, 14)) & vbTab & vbTab
auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(1, 21))
auxRetorno = auxRetorno & fnPulaLinha()

Do While Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 1)) <> vbNullString
    If Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 15)) = vbNullString Then

        auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 1)) & vbTab
        auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 3)) & vbTab & vbTab
        auxRetorno = auxRetorno & CCur(Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 6))) & vbTab & vbTab
        auxRetorno = auxRetorno & Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 7)) & vbTab
        auxRetorno = auxRetorno & CCur(Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 14))) & vbTab & vbTab
        auxRetorno = auxRetorno & CCur(Trim$(Sheets("Car Return - Danos").Cells(ContaLinhas, 21)))
        auxRetorno = auxRetorno & fnPulaLinha()

    End If

    ContaLinhas = ContaLinhas + 1

Loop

fnMontaListaDanos = auxRetorno

End Function

1 resposta
solução!

Se interessar a solução para alguem...

'Criação do ficheiro anexo de Returns (vai mudar de workbook)'

Dim WB As Workbook
Dim FileName As String

ActiveSheet.Copy
Set WB = ActiveWorkbook

FileName = WB.Worksheets(1).Name
On Error Resume Next
Kill "C:\Users\fabio\OneDrive\Área de Trabalho\" & FileName
On Error GoTo 0
WB.SaveAs FileName:="C:\Users\fabio\OneDrive\Área de Trabalho\" & FileName

'Montar o objeto e-mail'

Dim oOutlook As Object
Dim oEmail As MailItem

Set oOutlook = CreateObject("Outlook.Application")
Set oEmail = oOutlook.CreateItem(olMailItem)

oEmail.To = ""
oEmail.cc = "" & ";" & "" & ";" & ""
oEmail.Subject = " "
oEmail.Body = fnMontaCorpoEmail
oEmail.Attachments.Add (WB.FullName)
oEmail.Attachments.Add (WB2.FullName)
oEmail.Save

MsgBox ("E-mail enviado")

Set oOutlook = Nothing
Set oEmail = Nothing

Meu códibo gera 2 anexos (WB e WB2), o código do WB2 é identico ao WB, mas com outro nome.