Descargar adjuntos outlook automaticamente

[LuisMi83]

Maestros, saludos. Acudo a ustedes ya que en el aspecto de la programación soy totalmente un fiambre, y necesito un poco de orientación.

Me han pedido en el trabajo, una solución para que en outlook 2003, se pueda crear una regla que haga lo siguiente:

Al recibir los correos de ciertas personas, con datos adjuntos, estos se descarguen automáticamente al disco duro a una carpeta específica (los datos adjuntos), y una vez descargados, que se elimine entonces el correo en cuestión.

Ahora, he buscado en google y encontré muchos programas, add-ons, plugins, etc. que hacen lo solicitado, pero ninguno gratuito.

Sin embargo en una de las páginas que hallé, viene me parece que una Macro en visual basic, la cual por lo poco que entendí funcionaría para lo que estoy pidiendo.

Pero como ya les dije soy pésimo para programar y no entiendo un carajo, así que seguro no me ayudaría un copy-paste del código jaja. Bueno, les dejo el link de la página:

http://www.inquiry.com/techtips/exo_.../10min0700.asp

Ojalá alguno de ustedes pudiera ayudarme a entenderle, pero paso a paso, como si le estuvieran enseñando a un niño de 12 años.

De ante mano gracias.

Slds.

[dogduck]

Es una macro.
Luego con el editor de macros:

Tools > Macro > Macros, type a new name for your macro in the Macro Name field, and click Create.

Solo tienes que personalizar las variables:
oFolder ==> Bandeja de entrada

Set oFolder = oNS.GetDefaultFolder(olFolderInbox)

Se aplicará a los mensajes que provengan de mail con el nombre Report Generator

If .SenderName = "Report Generator" Then

y los guarda los adjuntos en c:\reports\in\ y despues borra los mensajes .delete

salu2

[LuisMi83]

Antes que nada, gracias por responder amigo. Bueno, como dije en mi post inicial, la programación y yo no nos llevamos para nada bien.

No entendí muy bien el segundo punto que mencionas, pero mira, mi código está asi:

Sub Attachments()
Dim oApp As Application
Dim oNS As NameSpace
Dim oMsg As Object
Dim oAttachments As Outlook.Attachments
Dim strControl

Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
strControl = 0

For Each oMsg In oFolder.Items
With oMsg
If .SenderName = "Edgar silva ortega" Then
strControl = strControl + 1
oMsg.Attachments.Item(1).SaveAsFile "C:\reports"
.Delete
End If
End With
Next
End Sub

Seguramente algo está mal, y agradeceré me lo hagas saber. Ya que al ejecutar la macro, me aparece el siguiente error:

"Se ha producido el error '-2147024891 (80070005)' en tiempo de ejecución:

No se puede guardar los datos adjuntos. No tiene el permiso necesario para realizar esta operación". Y bueno, no hace nada...

Espero puedas seguir orientandome, y disculpa si no entendí bien y mi pregunta es repetitiva..

Slds.

[dogduck]

Mirate Herramientas > Macros > Seguridad...
Revisa los permisos de c:\Reports ... Y si siguen los problemas averigua como firmar una macro ...

suerte

[LuisMi83]

Gracias nuevamente por la aydua amigo. Bueno al final logré hacerlo funcionar con otro código que encontré... un poco mas completo que el anterior.

Sub GetAttachments()

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder

GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Prueba")
i = 0

If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in Prueba folder.", vbInformation, _
"Nothing Found"

Exit Sub
End If

If SubFolder.Items.Count > 0 Then
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
FileName = "C:\reports\" & _
Format(Item.CreationTime, "dd mm yyyy_hh nn_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
End If

If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the C:\reports." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"

End If

End Sub

Ahora, todo funciona perfectamente, solo tengo dos dudas mas:

1.- Que puedo agregarle a esta macro, para evitar que me tome TODO lo que ve en los mensajes de correo como adjuntos? Es decir, si yo recibo un correo, que trae una imagen en la firma del mensaje, la macro toma esta imagen como si fuera un attachment, y lo guarda tambien en la carpeta especificada. Siendo que aunque en teoría entiendo que lo tome como adjunto, no lo es propiamente.

2.- Como se hace para que esta macro se ejecute cada que se reciba un correo nuevo? Porque hasta ahora, las pruebas funcionan de maravilla, pero yo tengo que ejecutar la macro manualmente. Puede ser que se ejecute automaticamente al recibir mail? O cada cierto tiempo??

Slds.

[skull118]

Por si alguien le sirve, tu has hecho 2 preguntas, utilice tu código y le hice una modificación para que me haga el filtro de los archivos que necesito.


Sub GetAttachments()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim strInter As String

'Abajo pongo el nombre o parte del nombre que necesito
strInter = "INTER_DIA.XLS"

GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments


'Esta linea comprueba si el archivo adjunto (Atmt), contiene el nombre o parte del nombre definido arriba (strInter), si lo contiene lo guarda.

If InStr(1, Atmt, strInter) Then
FileName = "C:\guardar\" & _
Format(Item.CreationTime, "dd mm yyyy_hh nn_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If


Next Atmt
Next Item
If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the C:\FRANCO\NICARAGUA\EXCEL." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If
End Sub

[ragde23fer]

Hola, muy buen aporte, pero no se ejecuta automaticamente al recibir un correo de alguna persona "x"... sabes como podria hacer en ese caso?... Gracias!

Saludos.

Iniciado por skull118

Por si alguien le sirve, tu has hecho 2 preguntas, utilice tu código y le hice una modificación para que me haga el filtro de los archivos que necesito.


Sub GetAttachments()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim strInter As String

'Abajo pongo el nombre o parte del nombre que necesito
strInter = "INTER_DIA.XLS"

GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments


'Esta linea comprueba si el archivo adjunto (Atmt), contiene el nombre o parte del nombre definido arriba (strInter), si lo contiene lo guarda.

If InStr(1, Atmt, strInter) Then
FileName = "C:\guardar\" & _
Format(Item.CreationTime, "dd mm yyyy_hh nn_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If


Next Atmt
Next Item
If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the C:\FRANCO\NICARAGUA\EXCEL." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If
End Sub