By Invitad@s el sábado, 01 de septiembre de 2018
Publicado en Kutools for Excel
Respuestas 0
Likes 0
Vistas 2.7K
Votos 0
Instalé kutools para ayudar con un proyecto de trabajo. También administro un informe de una gran empresa que tiene una macro que crea un correo electrónico a partir de la información ingresada. Esa macro ha dejado de funcionar en mi computadora. Funciona en las computadoras que no tienen kutools. ¿Alguien se ha encontrado con algo así antes? Aquí está la macro que funciona bien en otras computadoras:

SubMail_Sheet_Outlook_Body()
'Trabajando en Excel 2000-2016
Aplicación.Estilo de referencia = xlA1
Dim Rng As Range
Dim OutApp como objeto
Dim OutMail como objeto
Dim xFolder como cadena
Dim xSht como hoja de trabajo
Dim xSub como cadena
Respuesta tenue como cadena
Dim Msg como cadena
Estilo tenue como cadena
Título atenuado como cadena

Establecer xSht = hoja activa
Msg = "¿Está seguro de que desea enviar este formulario por correo electrónico?" ' Definir mensaje.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Definir botones.
Título = "Confirmación de envío de correo electrónico" ' Definir título.
Respuesta = MsgBox(Mensaje, Estilo)

Si Respuesta = vbSí Entonces
xFolder = Environ("PERFIL DE USUARIO") + "\Escritorio\" + "\Formulario de auditoría de campo--" + CStr(xSht.Cells(19, "A").Valor) + "--.pdf"
'xSub = "Auditoría de campo para la tienda" + CStr(xSht.Cells(19, "A").Value)
Con la aplicación
.EnableEvents = False
.ScreenUpdating = False
End With

Establecer rng = Nada
Establecer rng = ActiveSheet.UsedRange
'También puedes usar un nombre de hoja
'Establecer rng = Sheets("YourSheet").UsedRange

Establecer OutApp = CreateObject("Outlook.Application")
Establecer OutMail = OutApp.CreateItem(0)
Dim varCellvalue mientras dure




On Error Resume Next
Con correo saliente
.Para = ""
.CC = ""
.BCC = ""
.Asunto = "Recapitulación"
.Archivos adjuntos.Agregar xFolder
.HTMLBody = Rango a HTML (rng)
.Mostrar 'o usar .Mostrar

End With
En caso de error, vaya a 0

Con la aplicación
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nada
Set OutApp = Nada
Si terminar
End Sub


Función RangetoHTML(rng como rango)
'Trabajando en Office 2000-2016
Dim fso como objeto
Dimensiones como objeto
Dim TempFile como cadena
Dim TempWB como libro de trabajo

TempFile = Environ$("temp") & "\" & Format(Ahora, "dd-mm-aa h-mm-ss") & ".htm"

'Copie el rango y cree un nuevo libro de trabajo para pasar los datos en
rng.Copiar
Establecer TempWB = Libros de trabajo. Agregar (1)
Con TempWB.Hojas(1)
.Celdas(1).PastePegado especial:=8
.Cells(1).PasteSpecial xlPasteValues, , Falso, Falso
.Cells(1).PasteSpecial xlPasteFormats, , Falso, Falso
.Celdas(1).Seleccionar
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = Verdadero
.DrawingObjects.Eliminar
En caso de error, vaya a 0
End With

'Publicar la hoja en un archivo htm
Con TempWB.PublishObjects.Add( _
TipoFuente:=xlRangoFuente, _
Nombre de archivo:=TempFile, _
Hoja:=TempWB.Hojas(1).Nombre, _
Fuente:=TempWB.Sheets(1).UsedRange.Address, _
Tipo HTML:=xlHtmlEstático)
.Publicar (Verdadero)
End With

'Leer todos los datos del archivo htm en RangetoHTML
Establecer fso = CreateObject ("Scripting.FileSystemObject")
Establecer ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Cerrar
RangetoHTML = Reemplazar(RangetoHTML, "align=center x:publishsource=", _
"alinear = izquierda x: publicar fuente = ")

'Cerrar TempWB
TempWB.Cerrar cambios guardados:=Falso

'Eliminar el archivo htm que usamos en esta función
Matar archivo temporal
Establecer ts = Nada
Establecer fso = Nada
Establecer TempWB = Nada

Función finales
Ver publicación completa