[Outllok] Salvare gli allegati

[fiorella.fortunato]

Salve a tutti.

Premetto che ho Outlook 2000.

Sto cercando inutilmente di salvare in una cartella del mio PC gli allegati contenuti in alcuni messaggi che stanno dentro una cartella appositamente creata da me in outlook che è diversa da "posta in arrivo".
Ho cercato un po' dappertutto sia sui vari motori di ricerca che in questo forum ma ormai è da settimane che non riesco ad andare avanti.
La cartella si chiama "tracciati". Contiene dei file creati automaticamente da un server e a me spediti. Ho creato una regola che mi sposta quei messaggi con allegati nella cartella sopra menzionata.

Questa è la macro che ho creato ma che esegue ovviamente la sequenza nella cartella "posta in arrivo"

Codice: Seleziona tutto

Sub Scarica()
    Dim oApp As Application
    Dim oNS As NameSpace
    Dim oMsg As Object
    Dim oAttachments As Outlook.Attachments
    Dim strControl
    Set fs = CreateObject("Scripting.FileSystemObject")
           
    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 .UnRead = True Then
                strControl = strControl + 1
                If oMsg.Attachments.Count > 0 Then
                    For t = 1 To oMsg.Attachments.Count
                        nomeFile = "C:\prova\" & Year(.ReceivedTime) _
                            & Right("0" & Month(.ReceivedTime), 2) _
                            & Right("0" & Day(.ReceivedTime), 2) _
                            & Right("0" & Hour(.ReceivedTime), 2) _
                            & Right("0" & Minute(.ReceivedTime), 2) _
                            & oMsg.Attachments.Item(t).DisplayName
                        cerca = fs.FileExists(nomeFile)
                        If cerca = False Then
                            oMsg.Attachments.Item(t).SaveAsFile nomeFile
                        End If
                    Next
                End If
            End If
        End With
    Next
End Sub

La cartella tracciati è situata qui:

Codice: Seleziona tutto

+Archivio posta
|
+-[Altre cartelle tipiche di Outlook 2000]
|
+-Posta eliminata
|
+-Posta in uscita
|
+-Posta inviata
|
+-tracciati


C'è qualcuno esperto in programmmazione che sa come fare? Grazie

[fiorella.fortunato]

Ho scritto "Archivio posta" intendevo "Cartelle personali".

[Alexsandra]

Urca Fiorella !!!!!!
Non uso Outlook 2000 ma guardando il codice credo che si impallini quì

Codice: Seleziona tutto

Set oFolder = oNS.GetDefaultFolder(olFolderInbox)

in teoria và a prendersi la cartella di default che apri quando lanci l'applicazione ma non sò ancora come devi cambiare il codice.
ti cerco qualcosa
Urca !!!!!

[fiorella.fortunato]

Sono convinta anch'io sia quello l'errore. Ma non riesco a trovare negli help un qualcosa di sostitutivo che faccia al mio caso.
Grazie

[Alexsandra]

con "InBox" ti restituisce la cartella della posta in ingresso . Potresti provare così a spostarli nella tua cartella

Codice: Seleziona tutto

 Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objFSO = CreateObject("Scripting.FileSystemObject")
SaveAttachments(objFolder)

Function SaveAttachments(objFolder)
Set colItems = objFolder.Items
For Each objMessage in colItems
intCount = objMessage.Attachments.Count
If intCount > 0 Then
For i = 1 To intCount
strTempFile = objFSO.GetTempName
objMessage.Attachments.Item(i).SaveAsFile "C:\traccianti\" & strTempFile & "_" & _
objMessage.Attachments.Item(i).FileName
Next
End If
Next
For Each folder in objFolder.Folders
SaveAttachments(folder)
Next
End Function


PS.

Codice: Seleziona tutto

objMessage.Attachments.Item(i).SaveAsFile "C:\traccianti\" & strTempFile

cambia il percorso con quello che hai tu se li vuoi mettere in Documenti deve essere completo anche col nome utente
prova a copiare il codice in un file txt e salvalo ,poi cambia l'estensione da txt a vbs e fai doppio click sul file
Io non ho il 2000 e non sò se funziona provalo e fammi sapere
ciao

[cassioli]

Salve a tutti.

Premetto che ho Outlook 2000.

Sto cercando inutilmente di salvare in una cartella del mio PC gli allegati contenuti in alcuni messaggi che stanno dentro una cartella

Sto cercando anch'io da diversi mesi di farlo!
Ho trovato diversi programmi che lo fanno... ma tutti a pagamento, e io sono tirchio&programmatore, quindi sto cercando di farmelo da me...
Per il momento non ho ancora avuto grandissimo successo, ma mi sa che ieri sono forse arrivato a un punto decisivo.

La mia macro è ancora solo una bozza, ma sembrerebbe funzionare (anche se ho ancora capito bene... COME funziona! )

Codice: Seleziona tutto

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 NewAtmt As Attachment
 Dim AttachmentsSet As Attachments
 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
Rem Debug.Print Item.ItemProperties
'   Debug.Print "Il mex " & Item.Subject & " è di tipo " & Item.BodyFormat
   For Each Atmt In Item.Attachments
       FileName = "C:\temp" & Atmt.FileName
       Atmt.SaveAsFile FileName & "0"
       Item.Body = Item.Body & "----- attachments removed: ---------" & Atmt.FileName & " ---------------------" & vbCrLf
       Atmt.Delete
       i = i + 1
    Next Atmt
      Debug.Print Item.Attachments.Add("c:\prova.htm", , 1, "aaa")
  MyInspector = Item.GetInspector
  test = Item.Copy ' ??? copy in place of moving ???
  MyInspector.Move mia
 Next
 
 Rem Call DelAttachments

' Clear memory:
GetAttachments_exit:
   Set Atmt = Nothing
   Set Item = Nothing
   Set ns = Nothing
   Exit Sub
End Sub


Sto cercando di fare in modo che:
- l'allegato sia salvato
- l'allegato sia CANCELLATO dal messaggio (il mio .PST do outlook è gia' arrivato a 800 MB!!! )
- sostituire l'allegato con uno finto, in modo che nel messaggio resti visibile il "fermaglio" che indica che c'e' un allegato

Mi chiedo se sia possibile cambiare il nome con cui l'allegato viene elencato nell'intestazione del messaggio: vorrei sostituire tutti gli allegati con il file DUMMY.TXT, ma far visualizzare nella lista il vero nome.... ma non so se si puo' fare. Altrimenti saro' costretto a creare (? si puo' creare un file da una macro Outlook??) un dummy.txt per ogni allegato, e scriverci dentro il nome del doc...

Sito di riferimento per i programmatori outlook:
http://www.outlookcode.com/d/index.htm (anche se è piuttosto confusionario...)

[Alexsandra]

Prova quì http://www.slovaktech.com/code_samples. ... ttachments ci sono molte cose utili per outlook

[cassioli]

Prova quì http://www.slovaktech.com/code_samples. ... ttachments ci sono molte cose utili per outlook

Questa dev'essere la mia "fonte originale" (chisseloricorda...), che pero' non mi "piaceva" perche' toglieva dai mex il "fermaglio".

[fiorella.fortunato]

E' passato parecchio tempo e non mi sono fatta più viva. Non è stata una scortesia nei vostri confronti ma nonostante le vostre info fossero utili non erano quelle che facevano al mio caso. Mi ero solo riproposta di postare la soluzione nel qual caso avessi risolto il mio problema.
La soluzione l'avevo sotto i miei occhi e non me ne rendevo conto. E poco fa sono riuscita nel mio intento. Ecco il codice finale:

Codice: Seleziona tutto

Sub Scarica()
    Dim oApp As Application
    Dim oNS As NameSpace
    Dim oMsg As Object
    Dim oAttachments As Outlook.Attachments
    Dim strControl
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set ofolder = oNS.Folders.Item("Cartelle personali").Folders.Item("tracciati").Items
    strControl = 0
   
    For Each oMsg In ofolder
        With oMsg
            If .UnRead = True Then
                strControl = strControl + 1
                If oMsg.Attachments.Count > 0 Then
                    For t = 1 To oMsg.Attachments.Count
                        nomeFile = "C:\prova\" _
                            & Year(.ReceivedTime) _
                            & Right("0" & Month(.ReceivedTime), 2) _
                            & Right("0" & Day(.ReceivedTime), 2) _
                            & Right("0" & Hour(.ReceivedTime), 2) _
                            & Right("0" & Minute(.ReceivedTime), 2) _
                            & oMsg.Attachments.Item(t).DisplayName
                        cerca = fs.FileExists(nomeFile)
                        If cerca = False Then
                            oMsg.Attachments.Item(t).SaveAsFile nomeFile
                        End If
                    Next
                End If
            End If
        End With
    Next
End Sub

Ovviamente ringrazio coloro che si sono indaffarati a propormi una loro soluzione. Ciao

[Alexsandra]

Bel gesto ritornare a postare la soluzione.

Ciao

[Ribonix]

Perchè dici così?
Mi sembrava doveroso ed educato informare visto che comunque qualcuno si è dato da fare per me. Non frequento molto questo forum. E' forse consuetudine il contrario?

[fiorella.fortunato]

Abbiate pazienza, ma quel coyote del mio boyfriend mi ha fatto scrivere con il suo nick.
Ormai quando avevo postato era troppo tardi.

[Alexsandra]

..... Non frequento molto questo forum. ..

Prova a frequentarlo di più

[cassioli]

E' passato parecchio tempo e non mi sono fatta più viva. Non è stata una scortesia nei vostri confronti ma nonostante le vostre info fossero utili non erano quelle che facevano al mio caso. Mi ero solo riproposta di postare la soluzione nel qual caso avessi risolto il mio problema.
La soluzione l'avevo sotto i miei occhi e non me ne rendevo conto. E poco fa sono riuscita nel mio intento. Ecco il codice finale:

Con questo codice riesci anche a cancellare l'allegato dal messaggio e inserire nel messaggio stesso il nome dell'allegato? Io ho qualche problema a riuscirci... Vorrei aggiungere un allegato "fasullo" che sia invece un link all'allegato vero, cosi' conserverei l'icona del "fermaglio" nel messaggio: qualche idea su come fare?