La mia cassetta postale in MS Outlook dell'ufficio ha raggiunto le interessanti dimensioni di 500 MB (mannaggia agli allegati, mannaggia....).
E' possibile eliminare dai messaggi gli allegati senza eliminare i messaggi stessi?
Moderatori: Dylan666, hydra, gahan
kadosh ha scritto:No
feno ha scritto:creati un nuovo file pst.
Utilizza quello nuovo come default per la consegna e quello vecchio tienilo solo per consultazione.
Ti rocordo che con il file pst puoi arrivare fino a circa 2Gb poi si sput*** tutto
E' possibile eliminare dai messaggi gli allegati senza eliminare i messaggi stessi?
kadosh ha scritto:Sorry Cassioli ma quello che vuoi fare tu è diverso da ciò che hai scritto nella richiesta.
Dunque, nella prima frase:E' possibile eliminare dai messaggi gli allegati senza eliminare i messaggi stessi?
La risposta è sempre NO.
Sub GetAttachments()
' On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Item2 As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim MainFolder As MAPIFolder
Dim Explorer As Outlook.Explorer
' Dim MyInspector As Outlook.Inspector
Set ns = GetNamespace("MAPI")
Set MainFolder = ns.GetDefaultFolder(olFolderDrafts)
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("sent to")
Set mia = Inbox.Folders("archivio_mio")
Set Explorer = ActiveExplorer
i = 0
' Check for messages into folder:
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the folder.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Look for attachments:
For Each Item In SubFolder.Items
' If Item.Attachments.Count > 0 Then
' Item.Body = "Questo messaggio conteneva questi allegati:" & vbCrLf & Item.Body
' Item.HTMLBody = "Questo messaggio conteneva questi allegati:" & vbCrLf & Item.HTMLBody
' End If
For Each Atmt In Item.Attachments
FileName = "C:\temp\attach" & Atmt.FileName
Atmt.SaveAsFile FileName
Item.Body = "-----attachment removed:---------" & Atmt.FileName & " ---------------------" & vbCrLf & Item.Body
Item.HTMLBody = "-----attachment removed:--------- " & Atmt.FileName & " ---------------------" & vbCrLf & Item.HTMLBody
i = i + 1
Next Atmt
MyInspector = Item.GetInspector
test = Item.Copy ' ??? copy in place of moving ???
MyInspector.Move mia
Next
' Call DelAttachments
' Clear memory:
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
End Sub
Sub DelAttachments()
' On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Item2 As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim MainFolder As MAPIFolder
Dim Explorer As Outlook.Explorer
' Dim MyInspector As Outlook.Inspector
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("archivio_mio")
Set Explorer = ActiveExplorer
i = 0
' Check for messages into folder:
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the folder.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Look for attachments:
For Each Item In SubFolder.Items
If Item.Attachments.Count > 0 Then test = Item.Attachments.Remove(Item.Attachments.Count) ' Item.Copy ' ??? copy in place of moving ???
Next
' Clear memory:
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
End Sub
Sub GetAttachments()
' On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Item2 As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim MainFolder As MAPIFolder
Dim Explorer As Outlook.Explorer
' Dim MyInspector As Outlook.Inspector
Set ns = GetNamespace("MAPI")
Set MainFolder = ns.GetDefaultFolder(olFolderDrafts)
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("sent to")
Set mia = Inbox.Folders("archivio_mio")
Set Explorer = ActiveExplorer
i = 0
' Check for messages into folder:
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the folder.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Look for attachments:
For Each Item In SubFolder.Items
' If Item.Attachments.Count > 0 Then
' Item.Body = "Questo messaggio conteneva questi allegati:" & vbCrLf & Item.Body
' Item.HTMLBody = "Questo messaggio conteneva questi allegati:" & vbCrLf & Item.HTMLBody
' End If
For Each Atmt In Item.Attachments
FileName = "C:\temp\attach\" & Atmt.FileName
Atmt.SaveAsFile FileName
Item.Body = "-----attachment removed:---------" & Atmt.FileName & " ---------------------" & vbCrLf & Item.Body
Item.HTMLBody = "-----attachment removed:--------- " & Atmt.FileName & " ---------------------" & vbCrLf & Item.HTMLBody
i = i + 1
Next Atmt
MyInspector = Item.GetInspector
test = Item.Copy ' ??? copy in place of moving ???
MyInspector.Move mia
Next
Call DelAttachments
' Clear memory:
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
End Sub
Sub DelAttachments()
' On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Item2 As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim MainFolder As MAPIFolder
Dim Explorer As Outlook.Explorer
' Dim MyInspector As Outlook.Inspector
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("archivio_mio")
Set Explorer = ActiveExplorer
i = 0
' Check for messages into folder:
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the folder.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Look for attachments:
For Each Item In SubFolder.Items
Count = Item.Attachments.Count
If Count > 0 Then
For i = Count To 1 Step -1
Set att = Item.Attachments(i)
att.FileName
att.Delete
Next
Item.Save
End If
Next
' Clear memory:
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
End Sub
kadosh ha scritto:Carina la procedura, non avevo ancora intrallazzato su outlook però la sto provando e funziona, anche mettendo un eventuale mapping di rete.
Non mi va su win2k con outlook 2k, ma credo sia solo questione di dll mapi, stanotte do un'occhiata.
Problemi di ricezione Mail su outlook Autore: danibi60 |
Forum: Applicazioni Office Windows Risposte: 2 |
VBA per cliccare su pulsante in email outlook Autore: AleRosa |
Forum: Applicazioni Office Windows Risposte: 5 |
Sincronizzazione Google Outlook calendario=no va!!!! Autore: mp420 |
Forum: Software Windows Risposte: 1 |
Visitano il forum: Nessuno e 179 ospiti