Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
A better way to browse. Learn more.
A full-screen app on your home screen with push notifications, badges and more.
Este tema está ahora archivado y está cerrado a más respuestas.
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 Subaquí 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 FunctionGracias.
Ejemplo 2 Lista de Tareas.xlsm