MiyagiZama
New Member
- Joined
- Jul 26, 2023
- Messages
- 18
- Office Version
- 365
- Platform
- Windows
Hello mates!
I have a issue with my macro, it works, send the emails without problems but when I try to put my signature below the information, I dont know why appears above the image, could you help me with this please?
I want to put them below
Heres the code and some screenshots
I have a issue with my macro, it works, send the emails without problems but when I try to put my signature below the information, I dont know why appears above the image, could you help me with this please?
I want to put them below
Heres the code and some screenshots
VBA Code:
Sub MACROSUPPLYCHAIN()
'
'
Dim oLookApp As Outlook.Application
Dim oLookItm As Outlook.MailItem
Dim oLookIns As Outlook.Inspector
Dim TotalComentarios As String
Dim ComentariosLlenados As String
Dim PastDue As String
Dim cell As Range
Dim Correo As String
Dim Destinatario As String
Dim Asunto As String
Dim Dates As String
'
'DECLARE WORD VARIABLES
'
Dim oWrdDoc As Word.Document
Dim oWrdRng As Word.Range
'
'DECLARE EXCEL VARIABLES
'
Dim ExcRng As Range
'
On Error Resume Next
'
'GET THE ACTIVE INSTANCE OF OUTLOOK
'
Set oLookApp = GetObject(, "Outlook.Application")
'
'IF ERROR CREATE OR APPEARS GET THE NEXT INSTANCE
If Err.Number = 429 Then
'
'CLEAR ERROR
Err.Clear
'
Set oLookApp = New Outlook.Application
'
End If
'
'CREATE A REFERENCE TO THE EXCEL RANGE THAT WE WANT TO EXPORT
Set ExcRng = ThisWorkbook.Sheets("FormatoCorreo").Range("A1:F61")
'
'CREATE A NEW EMAIL
'
Set oLookApp = New Outlook.Application
'
For Each cell In ThisWorkbook.Sheets("InformacionNecesaria").Range("B2:B13")
'
'WE PUT IN BOLD THE VARIABLES
'
Correo = cell.Value
Destinatario = cell.Offset(0, -1).Value
TotalComentarios = cell.Offset(0, 3).Value
ComentariosLlenados = cell.Offset(0, 2).Value
PastDue = cell.Offset(0, 1).Value
Dates = cell.Offset(0, 4).Value
Asunto = "Ordenes en Past Due y Comentarios " & Dates
'
'THERES THE MESSAGE THAT WE WANT TO SEND
'
Msg1 = "<p style='font-family:arial;font-size:17'>Apreciable </>" 'poner destinatario en el html body'
Msg2 = " espero que se encuentre excelente el dia de hoy. <br/><br/><br/><br/>" 'PONER 2 SALTOS DE RENGLON AL FINAL DE HOY' 'SE PUSO SIN TEXTO HTML PARA QUE NO DIERA SALTO DE RENGLON'
Msg3 = "<p style='font-family:arial;font-size:17'>El motivo de este correo es para informarle que tiene </>" 'PASTDUE N' 2 LINE BREAK'
Msg4 = " ordenes en Past Due, </>"
Msg5 = " asi como le informamos que tiene </>" 'PUT COMENTARIOS LLENADOS'
Msg6 = " de un total de </>" 'PUT IN TOTAL DE COMENTARIOS'
Msg7 = " comentarios totales. </p><br/>" ' 2 SALTOS LINE BREAK'
Msg8 = "<p style='font-family:arial;font-size:17'>Favor de apoyarnos para juntos ir disminuyendo el BOL </p><br/><br/><br/>" '3 LINE BREAK'
Msg9 = "<p style='font-family:arial;font-size:17'>Atentamente:<br/><br/>" ' 1 LINE BREAK'
Msg10 = "<p style='font-family:arial;font-size:17'>Departamento de Supply Chain</p><br/><br/>" '3 LINE BREAK'
Msg11 = "<p style='font-family:arial;font-size:17'>ESTO ES UNA PRUEBA FAVOR DE OMITIR</>"
'
'WE CALLED IN TO OUTLOOK
'
Set oLookItm = oLookApp.CreateItem(olMailItem)
With oLookItm
'
'DISPLAY EMAIL
'
.Display
'.BodyFormat = olFormatHTML
.To = Correo
.Subject = Asunto
.HTMLBody = Msg1 & Destinatario & Msg2 & Msg3 & PastDue & Msg4 & Msg5 & ComentariosLlenados & Msg6 & TotalComentarios & Msg7 & Msg8 & Msg9 & Msg10 & Msg11 & .HTMLBody
'
'GET THE ACTIVE iNSPECTOR
'
Set oLookIns = .GetInspector
'
'GET THE WORD EDITOR
'
Set oWrdDoc = oLookIns.WordEditor
'
'SPECIFY THE RANGE IN THE DOCUMENT
'
Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
oWrdRng.Collapse Direction:=wdCollapseEnd
'
'ADD A NEW PARAGRAPH AND THEN INSERT A BREAK
'
Set oWrdRng = oWdEditor.Paragraphs.Add
oWrdRng.InsertBreak
'
'COPY THE RANGE
'
ExcRng.Copy
'
'PASTE IT
'
oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture
'.Send
'
End With
'
Next
'
'
End Sub