¿Cómo mantener los archivos adjuntos al responder en Outlook?
Cuando respondemos un mensaje de correo electrónico, los archivos adjuntos originales no se adjuntarán en el nuevo mensaje de respuesta. Aunque existen varios trucos para solucionar esto, aquí se presentará un truco sencillo y que una vez configurado se puede aplicar rápidamente a todos los mensajes recibidos.
Para ello debemos realizar por única vez los siguientes pasos:
Paso 1: En Outlook, presionar Alt + F11 para abrir Microsoft Visual Basic para Aplicaciones
Paso 2: Clic en Herramientas > Referencias, activar el cuadro de Microsoft Scripting Runtime y luego clic en Aceptar.
Paso 3: En la ventana principal, expanda los objetos de Projecto1 y Microsoft Outlook (en la barra izquierda) y haga doble clic en el ThisOutlookSession
Paso 4: En la ventana ThisOutlookSession pegue el siguiente código:
Sub ResponderConAdjuntos()
'Update by Extendoffice 20180830
Dim xReplyItem As Outlook.MailItem
Dim xItem As Object
On Error Resume Next
Set xItem = GetCurrentItem()
If xItem Is Nothing Then Exit Sub
Set xReplyItem = xItem.Reply
CopyAttachments xItem, xReplyItem
xReplyItem.Display
Set xReplyItem = Nothing
Set xItem = Nothing
End Sub
Sub ResponderATodosConAdjuntos()
Dim xReplyAllItem As Outlook.MailItem
Dim xItem As Object
Set xItem = GetCurrentItem()
If xItem Is Nothing Then Exit Sub
Set xReplyAllItem = xItem.ReplyAll
CopyAttachments xItem, xReplyAllItem
xReplyAllItem.Display
Set xReplyAllItem = Nothing
Set xItem = Nothing
End Sub
Function GetCurrentItem() As Object
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = Application.ActiveInspector.currentItem
End Select
End Function
Sub CopyAttachments(SourceItem As MailItem, TargetItem As MailItem)
Dim xFilePath As String
Dim xAttachment As Attachment
Dim xFSO As Scripting.FileSystemObject
Dim xTmpFolder As Scripting.Folder
Dim xFldPath As String
Set xFSO = New Scripting.FileSystemObject
Set xTmpFolder = xFSO.GetSpecialFolder(2)
xFldPath = xTmpFolder.Path & "\"
For Each xAttachment In SourceItem.Attachments
If IsEmbeddedAttachment(xAttachment) = False Then
xFilePath = xFldPath & xAttachment.Filename
xAttachment.SaveAsFile xFilePath
TargetItem.Attachments.Add xFilePath, , , xAttachment.DisplayName
xFSO.DeleteFile xFilePath
End If
Next
Set xFSO = Nothing
Set xTmpFolder = Nothing
End Sub
Function IsEmbeddedAttachment(Attach As Attachment)
Dim xAttParent As Object
Dim xCID As String, xID As String
Dim xHTML As String
On Error Resume Next
Set xAttParent = Attach.Parent
xCID = ""
xCID = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCID <> "" Then
xHTML = xAttParent.HTMLBody
xID = "cid:" & xCID
If InStr(xHTML, xID) > 0 Then
IsEmbeddedAttachment = True
Else
IsEmbeddedAttachment = False
End If
End If
End Function
Paso 5: Presionar Alt + Q para regresar a Outlook
Paso 6: Para facilitar el uso de estos macros las añadiremos a la cinta de opciones. En Outlook, clic derecho sobre la cinta de opciones y escoger "Personalizar la cinta de opciones..."
Paso 7: Esto nos llevara a la ventana de opciones, al apartado "Personalizar cinta de opciones". Primero vamos a crear un espacio para colocar los macros, con la pestaña "Inicio (correo)" seleccionada presionar el botón "Nuevo grupo" y luego personalizamos el nombre y el icono presionando el botón "Cambiar nombre..."
Escogemos un icono y nombre para este grupo.
Es recomendable subir el nuevo grupo hasta tenerlo al lado de los clásicos botones de responder.
Ahora, en los comandos disponibles seleccionar "Macros"
Aparecerán los dos macros que hemos creado:
- Proyecto1.ThisOutlookSession.ResponderATodosConAdjuntos: Responder a TODAS las personas en el correo, con los archivos adjuntos.
- Proyecto1.ThisOutlookSession.ResponderConAdjuntos: Responder solo a la persona que envió el correo, con los archivos adjuntos.
Pasar ambas macros al lado derecho (dentro del nuevo grupo creado), para ello presionar el botón Agregar
Paso 8: Finalmente, para hacer más amigables los botones, los vamos a embellecer. Para ello, seleccionar la macro que esta en el lado derecho luego presionar el botón "Cambiar nombre..."
Podemos cambiar el nombre y el símbolo por unos más entendibles (repetir para ambas macros).
Finalmente, ya quedo listo. Ahora cuando queramos responder un correo con los archivos adjuntos solo basta seleccionar uno de los dos botones creados ;)
Cuando respondemos un mensaje de correo electrónico, los archivos adjuntos originales no se adjuntarán en el nuevo mensaje de respuesta. Aunque existen varios trucos para solucionar esto, aquí se presentará un truco sencillo y que una vez configurado se puede aplicar rápidamente a todos los mensajes recibidos.
Para ello debemos realizar por única vez los siguientes pasos:
Paso 1: En Outlook, presionar Alt + F11 para abrir Microsoft Visual Basic para Aplicaciones
Paso 2: Clic en Herramientas > Referencias, activar el cuadro de Microsoft Scripting Runtime y luego clic en Aceptar.
Paso 3: En la ventana principal, expanda los objetos de Projecto1 y Microsoft Outlook (en la barra izquierda) y haga doble clic en el ThisOutlookSession
Paso 4: En la ventana ThisOutlookSession pegue el siguiente código:
Sub ResponderConAdjuntos()
'Update by Extendoffice 20180830
Dim xReplyItem As Outlook.MailItem
Dim xItem As Object
On Error Resume Next
Set xItem = GetCurrentItem()
If xItem Is Nothing Then Exit Sub
Set xReplyItem = xItem.Reply
CopyAttachments xItem, xReplyItem
xReplyItem.Display
Set xReplyItem = Nothing
Set xItem = Nothing
End Sub
Sub ResponderATodosConAdjuntos()
Dim xReplyAllItem As Outlook.MailItem
Dim xItem As Object
Set xItem = GetCurrentItem()
If xItem Is Nothing Then Exit Sub
Set xReplyAllItem = xItem.ReplyAll
CopyAttachments xItem, xReplyAllItem
xReplyAllItem.Display
Set xReplyAllItem = Nothing
Set xItem = Nothing
End Sub
Function GetCurrentItem() As Object
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = Application.ActiveInspector.currentItem
End Select
End Function
Sub CopyAttachments(SourceItem As MailItem, TargetItem As MailItem)
Dim xFilePath As String
Dim xAttachment As Attachment
Dim xFSO As Scripting.FileSystemObject
Dim xTmpFolder As Scripting.Folder
Dim xFldPath As String
Set xFSO = New Scripting.FileSystemObject
Set xTmpFolder = xFSO.GetSpecialFolder(2)
xFldPath = xTmpFolder.Path & "\"
For Each xAttachment In SourceItem.Attachments
If IsEmbeddedAttachment(xAttachment) = False Then
xFilePath = xFldPath & xAttachment.Filename
xAttachment.SaveAsFile xFilePath
TargetItem.Attachments.Add xFilePath, , , xAttachment.DisplayName
xFSO.DeleteFile xFilePath
End If
Next
Set xFSO = Nothing
Set xTmpFolder = Nothing
End Sub
Function IsEmbeddedAttachment(Attach As Attachment)
Dim xAttParent As Object
Dim xCID As String, xID As String
Dim xHTML As String
On Error Resume Next
Set xAttParent = Attach.Parent
xCID = ""
xCID = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCID <> "" Then
xHTML = xAttParent.HTMLBody
xID = "cid:" & xCID
If InStr(xHTML, xID) > 0 Then
IsEmbeddedAttachment = True
Else
IsEmbeddedAttachment = False
End If
End If
End Function
Paso 5: Presionar Alt + Q para regresar a Outlook
Paso 6: Para facilitar el uso de estos macros las añadiremos a la cinta de opciones. En Outlook, clic derecho sobre la cinta de opciones y escoger "Personalizar la cinta de opciones..."
Paso 7: Esto nos llevara a la ventana de opciones, al apartado "Personalizar cinta de opciones". Primero vamos a crear un espacio para colocar los macros, con la pestaña "Inicio (correo)" seleccionada presionar el botón "Nuevo grupo" y luego personalizamos el nombre y el icono presionando el botón "Cambiar nombre..."
Escogemos un icono y nombre para este grupo.
Es recomendable subir el nuevo grupo hasta tenerlo al lado de los clásicos botones de responder.
Ahora, en los comandos disponibles seleccionar "Macros"
Aparecerán los dos macros que hemos creado:
- Proyecto1.ThisOutlookSession.ResponderATodosConAdjuntos: Responder a TODAS las personas en el correo, con los archivos adjuntos.
- Proyecto1.ThisOutlookSession.ResponderConAdjuntos: Responder solo a la persona que envió el correo, con los archivos adjuntos.
Pasar ambas macros al lado derecho (dentro del nuevo grupo creado), para ello presionar el botón Agregar
Paso 8: Finalmente, para hacer más amigables los botones, los vamos a embellecer. Para ello, seleccionar la macro que esta en el lado derecho luego presionar el botón "Cambiar nombre..."
Podemos cambiar el nombre y el símbolo por unos más entendibles (repetir para ambas macros).
Finalmente, ya quedo listo. Ahora cuando queramos responder un correo con los archivos adjuntos solo basta seleccionar uno de los dos botones creados ;)
No hay comentarios:
Publicar un comentario