Visual Basic - Macro para manejar emails

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 21
Ha aumentado su posición en 2 puestos en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Macro para manejar emails

Publicado por Blas (15 intervenciones) el 06/07/2020 20:29:59
Hola a todos .estoy trabajando en la organización de los archivos adjuntos que me llegan x mail.
Había pensado en una regla de validación x VBA.

Cuando me llega un correo necesito que si el asunto tiene este nombre "asistencia 27-05-2020" (la fecha cambia) necesito extraer del asunto la fecha, invertirla y guardar su adjunto con el nombre 2020_05_27. extension (manteniendo la extension del adjunto)

(En este enlace aprendi a identificar algunas alertas del correo en outlook https://www.rankia.com.ar/blog/comstar/3938286-trucos-tretas-outlook-vba-para-programadores-macro-avisos-alertas)

tambien se que puedo meter algun IF o condicional que valide el asunto para saber si es el buscado o si debo seguir l, algo asi como

1
2
3
4
5
6
dim fecha, dia, mes, anio
IF itm.Subject = "asistencia cae*" then
      dia=mid(itm.Subject,16,2)
      mes=mid(itm.Subject,19,2)
      anio=mid(itm.Subject,22,4)
     fecha=anio&"_"&mes&"_"&dia

Tambien encontre un codigo que saca a txt los attachments encontrados.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub Work_with_Outlook()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim myItem As Object
Dim myAttachment As Outlook.Attachment
Dim olMail As Variant
Dim i As Long
 
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set myTasks = Fldr.Items
 
Set olMail = myTasks.Find("[Subject] = ""test""")
     While Not olMail Is Nothing
 
If olMail.Attachments.Count Then
 
    For Each myAttachment In olMail.Attachments
        i = i + 1
       myAttachment.SaveAsFile "\archivo_destino" & i & ".txt"
     Next myAttachment
 
End If
 
Set olMail = myTasks.FindNext
 
Wend
 
MsgBox "Scan Complete."
 
End Sub


Esta otra exporta los detalles del mail a un excel y funciona indistintamente desde Excel y desde Outlook.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub ExportToExcel(): On Error Resume Next
 
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
 
'Creamos la instancia a Excel
 
Set appExcel = CreateObject("Excel.Application")
 
Workbooks.Add
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.ActiveSheet
appExcel.Application.Visible = True
 
 
'Fila de cabecera
 
wks.Range("A1") = "Asunto"
wks.Range("B1") = "Cuerpo"
wks.Range("C1") = "Remitente"
wks.Range("D1") = "Destinatario"
wks.Range("E1") = "Importancia"
wks.Range("F1") = "Privacidad"
wks.Range("G1") = "Fecha"
 
'Seleccionamos la carpeta
 
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
If fld Is Nothing Then
 
   Exit Sub
 
End If
 
 
If fld.DefaultItemType <> olMailItem Or _
 
   fld.Items.Count = 0 Then
   MsgBox "La carpeta no contiene mensajes de correo electrónico"
   Exit Sub
 
End If
 
 
fila = 1
 
'Recorremos los mensajes
 
For Each itm In fld.Items
 
   If itm.Class = olMail Then
      fila = fila + 1
      wks.Range("A" & fila) = itm.Subject
      wks.Range("B" & fila) = itm.Body
      wks.Range("C" & fila) = itm.SenderName
      wks.Range("D" & fila) = itm.To
      wks.Range("E" & fila) = itm.Importance
      wks.Range("F" & fila) = itm.Sensitivity
      wks.Range("G" & fila) = itm.CreationTime
   End If
 
Next itm
 
 
'Ajustar al texto el cuepo del mensaje
 
wks.Range("B:B").WrapText = True
wks.Columns.ColumnWidth = 25
wks.Columns("B:B").ColumnWidth = 80
wks.Cells.VerticalAlignment = xlTop
 
 
MsgBox "*** Proceso de exportación de mensajes terminado correctamente ***"
 
'
'Limpiamos objetos
 
Set appExcel = Nothing
 
Set wkb = Nothing
Set wks = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
 
End Sub


Por ultimo les dejo este enlace que explica tambien como descargar los adjuntos a unas carpeta aunque no me ayuda a identificarlo

https://peterchirinos.wordpress.com/2018/09/14/descargar-archivos-adjuntos-a-una-carpeta-outlook-macro-visual-basic/


espero sus comentarios
Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder