Configurar email body e nome do ficheiro Excel

[fsoares81]

Boa tarde,

Estou a tentar a aprender a programar em VBA Excel, com o objectivo de criar uma pequena aplicação que me permita criar registos, e enviar por email num determinado formato. Após várias pesquisas, consegui arranjar código que me permitiu colocar a aplicação a funcionar, no entanto reconheço que ainda não tenho grandes conhecimentos.

De qualquer forma queria customizar um pouco mais a aplicação, uma das funcionalidades é copiar um Range de células da folha 1, colar numa nova folha (temporária) que depois é anexada no email para ser enviada.

Até aqui tudo bem, no entanto há 3 coisas que necessito melhorar:

--> no range que quero copiar da folha 1 existe uma imagem, que não consigo copiar. alguém sabe dizir-me o código ou função para o fazer?

-> ao criar o ficheiro temporário que depois é apagado, neste momento só consigo gravar com o nome da folha 1, é possível criar o nome do ficheiro em excel, importanto informação constante no meu formulário? por exemplo Pedido de Assistencia (id).xls?

--> Por fim, da mesma forma que configurar o nome do ficheiro, é possível no texto do email, colocar informaçãoes das textbox ou combobox?

Envio abaixo o código da parte em que cria o ficheiro e envia por email:

Private Sub CmdEnviar_Click()
Dim vNovoArquivo		   As Workbook
Dim vPlanAtiva			 As Worksheet
Dim vNovaPlanilha		  As Integer
Dim sbEnviarPlanilha	   As String
Dim txArquivoExiste		As String
Dim sbExcluirArqTemporario As String
Dim vDestino, vTitulo	  As String
Dim vLinCol				As Long
Dim txArquivoNumero		As Long
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim strbody As String


'- - - - - - - - - - - - - - - - - - -
'txArquivoExiste = ".xlsb": txArquivoNumero = 50
'txArquivoExiste = ".xlsx": txArquivoNumero = 51
'txArquivoExiste = ".xlsm": txArquivoNumero = 52
'- - - - - - - - - - - - - - - - - - -
'vamos utilizar o formato (56) (xls)
txArquivoExiste = ".xls": txArquivoNumero = 56


'Instrução exibe o número de planilhas automaticamente inseridas em novas pastas de trabalho
vNovaPlanilha = Application.SheetsInNewWorkbook

'aqui definimos somente a planiha na ordem para nosso arquivo desejado
 Application.SheetsInNewWorkbook = 1


'vamos definir a planilha que se tonará ativa
 Set vPlanAtiva = Sheets("Form Ricotel")
	  On Error Resume Next

'Sheets(CStr(vPlanAtiva)).Select
'usamos a instrução set para variavel para expandir para mais tres colunas
'vamos copiar somente os dados filtrados como (setamos) acima
 Folha1.Range("A1:AD61").Copy

'Aqui vamos definir a folha de planiha do livro que enviaremos anexo em nosso email,
'observem que poderá ser qualquer folha de planilha
 sbEnviarPlanilha = "Form Ricotel"

'vamos adicionar ou criar um novo arquivos(wkb) no aplicativo excel
 Set vNovoArquivo = Application.Workbooks.Add

'vamos fazer uma cola especial e colar somente os valores em nossa planilha ativa que será formatada.
 With ActiveSheet
	 .Range("A4").PasteSpecial Paste:=xlPasteValues
	 .Range("A4").PasteSpecial Paste:=xlPasteFormats
	 .Range("A:AD").ColumnWidth = 3
 End With

 Application.CutCopyMode = False

'vamos definir o nome da folha de planilha para a folha de planilha copiada
 With ActiveSheet
	  .Name = sbEnviarPlanilha
	  .Range("A1").Select
 End With

'essa linha de código enibe a mensagem do aplicativo excel
 Application.DisplayAlerts = False

'vamos salvar nosso arquivo com o nome da folha de planilha que foi copiada no formato 2010 - xlsx (51)
 vNovoArquivo.SaveAs Filename:=Sheets("Form Ricotel").Range("X4").Text & ThisWorkbook.Path & "\" & "" & sbEnviarPlanilha & txArquivoExiste, FileFormat:=txArquivoNumero

 sbExcluirArqTemporario = vNovoArquivo.FullName


 Set OutApp = CreateObject("Outlook.Application")

 Set OutMail = OutApp.CreateItem(0)

 strbody = "Bom dia,<br><br>" & _
		   "Sr. Fernando,<br><br>" & _
		   "Envio em anexo novo pedido de assistência técnica.<br><br>" & _
		   "Cumprimentos,<br>"

 SigString = Environ("appdata") & _
			 "\Microsoft\Signatures\Filipe Soares.htm"

 If Dir(SigString) <> "" Then
	Signature = GetBoiler(SigString)
 Else
	Signature = ""
 End If

 On Error Resume Next

' Change the mail address and subject in the macro before you run this procedure.
 With OutMail
	  .To = "filipe-soares@iol.pt"
	  .CC = ""
	  .BCC = ""
	  .Subject = "Novo Pedido de Assistência"
	  .HTMLbody = strbody & "<br><br>" & Signature
	  .Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
'.Send
	  .Display
 End With
 On Error GoTo 0

'Fechando o arquivo novo, observe que usei aqui Close e não Quit(Fecha todo Aplicativo)
	 vNovoArquivo.Close

'Instrução Kill deletará nosso arquivo temporariamente criado para o envio do email.
	 Kill sbExcluirArqTemporario

'Instrução exibe o número de planilhas automaticamente inseridas em novas pastas de trabalho
	Application.SheetsInNewWorkbook = vNovaPlanilha

End Sub

[jpaulino]

--> no range que quero copiar da folha 1 existe uma imagem, que não consigo copiar. alguém sabe dizir-me o código ou função para o fazer?

Como attach do email?

--> ao criar o ficheiro temporário que depois é apagado, neste momento só consigo gravar com o nome da folha 1, é possível criar o nome do ficheiro em excel, importanto informação constante no meu formulário? por exemplo Pedido de Assistencia (id).xls?

Só tens de definir em sbEnviarPlanilha, ou seja, sbEnviarPlanilha = "Pedido de Assistencia (id)" em vez de sbEnviarPlanilha = "Form Ricotel"

--> Por fim, da mesma forma que configurar o nome do ficheiro, é possível no texto do email, colocar informaçãoes das textbox ou combobox?

Das textbox ou combobox que tens num userform? Sim claro, na variável strbody podes lá colocar qualquer coisa, tens é de explicar melhor o que queres.

[fsoares81]

Citação

Como attach do email?

antes de enviar o email, a aplicação copia um Range de células da folha 1 para um folha temporária sendo que de seguida anexa essa folha temporária no email. Na Folha 1, tem um logotipo que não consigo copiar no Range de células, usando: Folha1.Range("A1:AD61").Copy copia tudo menos a imagem. como consigo fazer?