none
Macro para envio de arquivo por e-mail RRS feed

  • Pergunta

  • oi como vai, eu tenho uma planilha que eu gostaria de melhorar utilizando o recurso de envio por e-mail. Ex. após criar o arquivo coo mostra a macro abaixo gostaria de utilizar a macro de envio de e-mail e incluir esse arquivo criado dentro do e-mail.

    Podem me ajudar a criar essa macro?

    Sub RoundedRectangle1_Click()
    Dim ano As Integer, mes As String, dia As String, data As String
    Dim Caminho As String
    ano = Year(Date)
    If Len(Month(Date)) = 1 Then
    mes = "0" & Month(Date)
    Else
    mes = Month(Date)
    End If
    If Len(Day(Date)) = 1 Then
    dia = "0" & Day(Date)
    Else
    dia = Day(Date)
    End If
    data = "Motivo Retorno - " & ano & "." & mes & "." & dia
    Application.ScreenUpdating = False
    Calculate
    ActiveWorkbook.Save
    Sheets("Base").Visible = True
    'Salvar Sem Formulas
    Sheets("Base").Select
    Caminho = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    ThisWorkbook.SaveAs FileName:=Caminho & data & ".xlsm" _
    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Sheets("Base").Activate
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    'Deletar botão SALVAR
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.Delete
    ActiveWindow.DisplayHeadings = False
    Sheets("Base").Select
    Range("A1").Select
    'Deletar Sheets
    Sheets(Array("CLI_SAP", "Motivo")).Delete
    Calculate
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
    End Sub

    domingo, 7 de dezembro de 2014 20:19

Respostas