
'In Questa_sessione_di_outlook
Public WithEvents myOlItems As Outlook.items
Public Sub Application_Startup()
' Reference the items in the Inbox. Because myOlItems is declared
' "WithEvents" the ItemAdd event will fire below.
Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
MsgBox "E' arrivata nuova posta: " & vbCrLf & Item
End Sub
|
Private Sub SaveAllMsg()
Dim my_path As String
Dim oEmail As MailItem, s As String, tmp As String, v As Variant
my_path = "G: est"
'se si vuole, si può creare un piccolissimo userform (il cui nome deve essere userform1)
'che contiene solo una label (di nome label1) abbastanza lunga da mostrare quel che succede
'in caso si crei l'userform1, decommentare la riga che segue
'UserForm1.Show vbModeless
'processa la sottocartella specificata di Outlook, recupera ogni messaggio e lo salva in formato .msg
'nella cartella in my_path
For Each oEmail In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("mia sottocartella").items
'costruisce il nome del file messaggio da salvare:
'prime 10 lettere del mittente
'+ primi 30 caratteri dell'oggetto (depurati dei caratteri non DOS compliant)
'+ data in formato ISO (aaaammggoomm)
tmp = oEmail.SenderName
If InStr(tmp, "@") Then
s = Mid(Left(tmp, 10), 1, InStr(tmp, "@") - 1)
ElseIf InStr(tmp, " ") Then
s = Replace(Left(tmp, 10), " ", "_")
End If
tmp = Trim(oEmail.Subject)
If tmp = "" Then
tmp = "(senza oggetto)"
Else
For Each v In Array(".", ":", "", "/", "?", "*", "+", Chr$(34), "<", ">", "|")
tmp = Replace(tmp, CStr(v), "")
Next
End If
If Len(tmp) > 25 Then tmp = Left(tmp, 25) & "..."
s = s & " - " & tmp & " (" & Format(oEmail.CreationTime, "yyyymmddhhnn") & ").msg"
'in caso sia stata creata la userform di monitoraggio degli eventi, decommentare le due righe che seguono
'DoEvents
'UserForm1.Label1.Caption = oEmail
oEmail.SaveAs my_path & s, olMSG
Next
'in caso sia stata creata la userform di monitoraggio degli eventi, decommentare la riga che segue
'Unload UserForm1
MsgBox "All done."
End Sub |
For i = 1 To Len(tmp)
If UCase(Mid(tmp, i, 1)) Like "[!A-Z0-9]" Then tmp = Replace(tmp, Mid(tmp, i, 1), "")
Next
|
For Each cella In rng if cella.Offset(0, 5) = cella.Offset(0, 5) then cella.Offset(0, 5).Interior.ColorIndex = vbYellow end if Next |
Private Sub SaveAllMsg()
Dim ...
...
On Error Goto gest_err
For Each oEmail In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("mia sottocartella").items
...
oEmail.SaveAs my_path & s, olMSG ' se si evrifica un errore qui, salta a gest_err
Next
...
MsgBox "All done."
Exit Sub ' importante! altrimenti viene eseguito quanto segue
gest_err:
'gestiamo l'errore senza interrompere il programma
'visualizza un box informativo
'potrebbe anche creare un file dove scrivere il codice d'errore e la sua descrizione
MsgBox "Si è verificato un errore: " & err.number & " - " & err.description
On Error Resume Next
End Sub |
Private Sub SaveAllMsg()
Dim my_path As String
Dim oEmail As MailItem, s As String, tmp As String, v As Variant
my_path = "c: est"
'se si vuole, si può creare un piccolissimo userform (il cui nome deve essere userform1)
'che contiene solo una label (di nome label1) abbastanza lunga da mostrare quel che succede
'in caso si crei l'userform1, decommentare la riga che segue
'UserForm1.Show vbModeless
'processa la sottocartella specificata di Outlook, recupera ogni messaggio e lo salva in formato .msg
'nella cartella in my_path
On Error GoTo gest_err
For Each oEmail In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
'costruisce il nome del file messaggio da salvare:
'prime 10 lettere del mittente
'+ primi 30 caratteri dell'oggetto (depurati dei caratteri non DOS compliant)
'+ data in formato ISO (aaaammggoomm)
tmp = oEmail.SenderName
If InStr(tmp, "@") Then
s = Mid(Left(tmp, 10), 1, InStr(tmp, "@") - 1)
ElseIf InStr(tmp, " ") Then
s = Replace(Left(tmp, 10), " ", "_")
End If
tmp = Trim(oEmail.Subject)
If tmp = "" Then
tmp = "(senza oggetto)"
Else
For Each v In Array(".", ":", "", "/", "?", "*", "+", Chr$(34), "<", ">", "|", "(", ")", Chr$(252), Chr$(220))
tmp = Replace(tmp, CStr(v), "")
Next
End If
If Len(tmp) > 25 Then tmp = Left(tmp, 25) & "..."
s = s & " - " & tmp & " (" & Format(oEmail.CreationTime, "yyyymmddhhnn") & ").msg"
'in caso sia stata creata la userform di monitoraggio degli eventi, decommentare le due righe che seguono
'DoEvents
'UserForm1.Label1.Caption = oEmail
oEmail.SaveAs my_path & s, olMSG
Next
'in caso sia stata creata la userform di monitoraggio degli eventi, decommentare la riga che segue
'Unload UserForm1
Exit Sub ' importante! altrimenti viene eseguito quanto segue
gest_err:
'gestiamo l'errore senza interrompere il programma
'visualizza un box informativo
'potrebbe anche creare un file dove scrivere il codice d'errore e la sua descrizione
MsgBox "Si è verificato un errore: " & Err.Number & " - " & Err.Description
Resume Next
End Sub
|
