VBA codigo em excel

tromao

Power Member
Estou com um problema...

Como podem ver pelo codigo em baixo, consigo abrir a email msg e copiar certos campos, no entatno não estou a conseguir preencher o CORPO da mensagem.Qu código deverei escrever para ele me fazer o paste do range ja antes copiado desde o excel?

Abraço e desde ja mto obrigado.
Código:
Sub sendemail()
'
' sendemail Macro
'

'
       
         Dim OutApp As Object
 Dim OutMail As Object
    Sheets("Plan2").Select
    Range("E96").Select
    ActiveCell.FormulaR1C1 = "=Plan1!R[-92]C[7]"
    Range("E96").Select
    Selection.AutoFill Destination:=Range("E96:E123"), Type:=xlFillDefault
    Range("E96:E123").Select
    
If Range("plan1!d29").Value = "" Then

Dim i As Integer
For i = 116 To 123
If Range("E" & i).Value = "" Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
End If
Next i

      Range("e96:e123").Select
      Range("e96:e123").Copy
      
 Set OutApp = CreateObject("Outlook.Application")
 OutApp.Session.Logon
 Set OutMail = OutApp.CreateItem(0)

 On Error Resume Next
 With OutMail
 .From = "Lis-flightrelease"
 .To = ToAddressTxt
 .CC = "lis-flightrelease"
 .Subject = Range("e96")

'------------------------------------------

 .Body = Range("e96:e123").paste

'-----------------------------------------
 .Display
 End With
    
    
    Sheets("Plan1").Select
    Range("b11").Select
    
Else
    
For i = 117 To 123
If Range("E" & i).Value = "" Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
End If
Next i

      Range("e96:e123").Select
      Range("e96:e123").Copy
      
 Set OutApp = CreateObject("Outlook.Application")
 OutApp.Session.Logon
 Set OutMail = OutApp.CreateItem(0)

 On Error Resume Next
 With OutMail
 .From = "Lis-flightrelease"
 .To = ToAddressTxt
 .CC = "lis-flightrelease"
 .Subject = Range("e96")
 
 .Body = Range("e96:e123").Paste
 .Display
 End With
    
    
    Sheets("Plan1").Select
    Range("b11").Select
        
        End If
End Sub
 
Última edição pelo moderador:
Back
Topo