MiyagiZama
New Member
- Joined
- Jul 26, 2023
- Messages
- 18
- Office Version
- 365
- Platform
- Windows
Hello mates! , finally my code run without problems, but I want to improve some details...
Here's the catch, I have this macro which send emails, with different information for the agents, everyone had a personal email, where includes their statistics, I put a table where the macro get the information using offset, but I want to these info appears in bold on the email, I try other ways to change the format, but it only works and change in the worksheet not in the email, could you assist to me please with this inconvenient?
Here's the VBA code
Here's the catch, I have this macro which send emails, with different information for the agents, everyone had a personal email, where includes their statistics, I put a table where the macro get the information using offset, but I want to these info appears in bold on the email, I try other ways to change the format, but it only works and change in the worksheet not in the email, could you assist to me please with this inconvenient?
Here's the VBA code
VBA Code:
Sub duiduiduidui()
'
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("1").Range("A1:F61")
'
'CREATE A NEW EMAIL
'
Set oLookApp = New Outlook.Application
'
For Each cell In ThisWorkbook.Sheets("2").Range("B2:B13")
'
'WE PUT IN BOLD THE VARIABLES
'
Worksheets("2").Range("C2:E13").Font.Bold = True
'
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, 6).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
.To = Correo
.Subject = Asunto
.HTMLBody = Msg1 & Destinatario & Msg2 & Msg3 & PastDue & Msg4 & Msg5 & ComentariosLlenados & Msg6 & TotalComentarios & Msg7 & Msg8 & Msg9 & Msg10 & Msg11
'
'DISPLAY EMAIL
'
.Display
'
'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