[VB.NET/2012] Automatismi VB ed Outlook 2013

[fil70]

Risolto in parte con VBA. Resta un errore come da file allegato.

Posto il codice:

Sub Salva_File_Allegato()
On Error GoTo Salva_File_Allegato_err

Dim appOl As New Outlook.Application
Dim ns As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String
Dim i As Integer
Set ns = appOl.GetNamespace("MAPI")


Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Anteo")
i = 0

If SubFolder.Items.Count = 0 Then
MsgBox "Non ci sono nuovi messaggi nella posta in arrivo.", vbInformation, _
"Avviso"
Exit Sub
End If

For Each Item In SubFolder.Items

For Each Atmt In Item.Attachments

FileName = "C:\testxml\xsi\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item

If i > 0 Then
MsgBox "Ho trovato " & i & " files con allegati." _
& vbCrLf & "Questi sono stati salvati in C:\testxml\csi\" _
& vbCrLf & vbCrLf & "Ciao.", vbInformation, "Operazione conclusa!"
Else
MsgBox "Non ci sono nuovi allegati da salvare.", vbInformation, "Operazione conclusa!"
End If

Salva_File_Allegato_exit:

Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set appOl = Nothing
Exit Sub

Salva_File_Allegato_err:
MsgBox "Si è verificato un errore inaspettato." _
& vbCrLf & "Ti invitiamo a prendere nota e segnalare la presenza di questo errore." _
& vbCrLf & "Nome applicazione: Salva_File_Allegato" _
& vbCrLf & "Errore Numero: " & Err.Number _
& vbCrLf & "Descrizione Errore: " & Err.Description _
, vbCritical, "Errore!"
Resume Salva_File_Allegato_exit
End Sub