Muy buen día compañeros,

Espero me puedan ayudar con un problema muy simple de outlook, lo que requiero hacer es que al momento de que yo le de en el correo que acabo de recibir responder a todos a parte de anexar a todos los destinatarios me adjunte, los archivos que tenga.

Saludos y gracias por la ayuda.

Les detallo un poco mas, yo recibo un correo con un documento adjunto y lo que deseo realizar es que cuando yo le de clic en un boton de responder a todos en automatico me jale los documentos adjuntos a este nuevo correo con todas las direcciones que vengan en este.

Hola que tal amigos del Foro, pues muchas gracias, pero que mala onda que nadie visito mi duda, les comento que ya tengo la solución de la macro por si les sirve a alguien.

Sub ReplyWithAttachments()

Dim rpl As Outlook.MailItem

Dim itm As Object

Set itm = GetCurrentItem()

If Not itm Is Nothing Then

Set rpl = itm.ReplyAll

CopyAttachments itm, rpl

rpl.Display

End If

Set rpl = Nothing

Set itm = Nothing

End Sub

Function GetCurrentItem() As Object

Dim objApp As Outlook.Application

Set objApp = Application

On Error Resume Next

Select Case TypeName(objApp.ActiveWindow)

Case "Explorer"

Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)

Case "Inspector"

Set GetCurrentItem = objApp.ActiveInspector.CurrentItem

End Select

Set objApp = Nothing

End Function

Sub CopyAttachments(objSourceItem, objTargetItem)

Set fso = CreateObject("Scripting.FileSystemObject")

Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder

strPath = fldTemp.Path & "\"

For Each objAtt In objSourceItem.Attachments

strFile = strPath & objAtt.FileName

objAtt.SaveAsFile strFile

objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName

fso.DeleteFile strFile

Next

Set fldTemp = Nothing

Set fso = Nothing

End Sub

Saludos

- - - - - Mensaje combinado - - - - -

Sub ReplyWithAttachments()

Dim rpl As Outlook.MailItem

Dim itm As Object

Set itm = GetCurrentItem()

If Not itm Is Nothing Then

Set rpl = itm.ReplyAll

CopyAttachments itm, rpl

rpl.Display

End If

Set rpl = Nothing

Set itm = Nothing

End Sub

Function GetCurrentItem() As Object

Dim objApp As Outlook.Application

Set objApp = Application

On Error Resume Next

Select Case TypeName(objApp.ActiveWindow)

Case "Explorer"

Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)

Case "Inspector"

Set GetCurrentItem = objApp.ActiveInspector.CurrentItem

End Select

Set objApp = Nothing

End Function

Sub CopyAttachments(objSourceItem, objTargetItem)

Set fso = CreateObject("Scripting.FileSystemObject")

Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder

strPath = fldTemp.Path & "\"

For Each objAtt In objSourceItem.Attachments

strFile = strPath & objAtt.FileName

objAtt.SaveAsFile strFile

objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName

fso.DeleteFile strFile

Next

Set fldTemp = Nothing

Set fso = Nothing

End Sub

Gracias por compartir la solución y lamento no haber podido echarte una mano.

Buenas puedes usar al igual que en Excel el evento Open para ocultar la aplicación Seria colocar en el módulo ThisDocument del documento lo siguiente

______________________________________________________________________

NoorAlamShahzad

Buenas puedes usar al igual que en Excel el evento Open para ocultar la aplicación Seria colocar en el módulo ThisDocument del documento lo siguiente

_____________________________________________________________

Try out our free mcse and latest comptia 70-680 pdf training courses to get high flying success in final and mcse cost exams