Saludos, mi consulta es acerca del objeto (olTaskItem) de Outlook.Application desde macros de excel, tengo que asignar una tarea y el cuerpo del mensaje quiero que se inserte en formato BodyHTML, pero me genera un error diciendo que el objeto no admite esta propiedad o método, quieseira saber si es posible insertar el cuepor del mensaje con HTML pero si definitivamente no se puede que lo inserte como imagen. relaciono archivo y código, agradezco la ayuda que me puedan brindar.
Dim objOL As Outlook.Application
Dim myItem As Outlook.TaskItem
Dim myDelegate As Outlook.Recipient
Dim rng As Range
Set rng = Nothing
Set objOL = Outlook.Application
u = Sheets(2).Range("A2").End(xlDown).Row
If u > 65500 Then
MsgBox "No existe información para enviar..."
GoTo SALEPRIN
End If
For i = 3 To u
If Sheets(2).Cells(i, 7) <> Empty Then
GoTo siguiente
End If
asunto = Sheets(2).Cells(i, 1)
inicio = Sheets(2).Cells(i, 2)
fin = Sheets(2).Cells(i, 3)
'detalle = RngetoHTML(rng)a 'Sheets(2).Cells(i, 4)
aviso = Sheets(2).Cells(i, 5)
para = Sheets(2).Cells(i, 6)
Set objOL = Outlook.Application
Set objNS = objOL.CreateItem(olMailItem)
With objNS
Set mytarea = objOL.CreateItem(olTaskItem)
'Set myItem = objOL.CreateItem(TaskItem)
Set myDelegate = mytarea.Recipients.Add(para)
'a = myItem.Assign
'mytarea.Display
mytarea.Assign
'myDelegate.Resolve
'If myDelegate.Resolved Then
'mytarea.Display
mytarea.Importance = 2
mytarea.Subject = asunto
mytarea.StartDate = inicio
mytarea.DueDate = fin
mytarea.ReminderSet = True
mytarea.ReminderTime = aviso
'mytarea.Body = detalle
mytarea.HTMLBody = RangetoHTML(rng)
mytarea.Save
'mytarea.Display
' myTarea.Close
mytarea.Send
'End If
'creacion = Format(mytarea.CreationTime, dd - mm - yyyy)
creacion = Format(Date, dd - mm - yyyy)
'----------------------------///------------------------------
'----------------------------///------------------------------
'.Display
'.Send
End With
Set objOL = Nothing
Set objNS = Nothing
Sheets(2).Cells(i, 8) = creacion 'Format(Now() - 1, dd - mm - yyyy)
Sheets(2).Cells(i, 7) = "Asignado"
'Set OBJETOCORREO = Nothing
'Set OBJETOLOOK = Nothing
siguiente:
Next
SALEPRIN:
MsgBox "Ok Asignado"
End Sub
aquí mi función.
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
Range("K1:X20").Copy
'rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Buen día
Saludos, mi consulta es acerca del objeto (olTaskItem) de Outlook.Application desde macros de excel, tengo que asignar una tarea y el cuerpo del mensaje quiero que se inserte en formato BodyHTML, pero me genera un error diciendo que el objeto no admite esta propiedad o método, quieseira saber si es posible insertar el cuepor del mensaje con HTML pero si definitivamente no se puede que lo inserte como imagen. relaciono archivo y código, agradezco la ayuda que me puedan brindar.
Dim objOL As Outlook.Application Dim myItem As Outlook.TaskItem Dim myDelegate As Outlook.Recipient Dim rng As Range Set rng = Nothing Set objOL = Outlook.Application u = Sheets(2).Range("A2").End(xlDown).Row If u > 65500 Then MsgBox "No existe información para enviar..." GoTo SALEPRIN End If For i = 3 To u If Sheets(2).Cells(i, 7) <> Empty Then GoTo siguiente End If asunto = Sheets(2).Cells(i, 1) inicio = Sheets(2).Cells(i, 2) fin = Sheets(2).Cells(i, 3) 'detalle = RngetoHTML(rng)a 'Sheets(2).Cells(i, 4) aviso = Sheets(2).Cells(i, 5) para = Sheets(2).Cells(i, 6) Set objOL = Outlook.Application Set objNS = objOL.CreateItem(olMailItem) With objNS Set mytarea = objOL.CreateItem(olTaskItem) 'Set myItem = objOL.CreateItem(TaskItem) Set myDelegate = mytarea.Recipients.Add(para) 'a = myItem.Assign 'mytarea.Display mytarea.Assign 'myDelegate.Resolve 'If myDelegate.Resolved Then 'mytarea.Display mytarea.Importance = 2 mytarea.Subject = asunto mytarea.StartDate = inicio mytarea.DueDate = fin mytarea.ReminderSet = True mytarea.ReminderTime = aviso 'mytarea.Body = detalle mytarea.HTMLBody = RangetoHTML(rng) mytarea.Save 'mytarea.Display ' myTarea.Close mytarea.Send 'End If 'creacion = Format(mytarea.CreationTime, dd - mm - yyyy) creacion = Format(Date, dd - mm - yyyy) '----------------------------///------------------------------ '----------------------------///------------------------------ '.Display '.Send End With Set objOL = Nothing Set objNS = Nothing Sheets(2).Cells(i, 8) = creacion 'Format(Now() - 1, dd - mm - yyyy) Sheets(2).Cells(i, 7) = "Asignado" 'Set OBJETOCORREO = Nothing 'Set OBJETOLOOK = Nothing siguiente: Next SALEPRIN: MsgBox "Ok Asignado" End Sub
aquí mi función.
Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016 Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 'Copy the range and create a new workbook to past the data in Range("K1:X20").Copy 'rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With 'Publish the sheet to a htm file With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With 'Read all data from the htm file into RangetoHTML Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.readall ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") 'Close TempWB TempWB.Close savechanges:=False 'Delete the htm file we used in this function Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function
Gracias.
Ejemplo 2 Lista de Tareas.xlsm