enlever la confirmation d'accès [Résolu]

[bryony]

Bonjour,

cette question à du être posé des milliers de fois mais je tourne en rond et je ne trouve pas la solution.
J'ai créé une macro qui parcour ma boite mail afin d'archiver les mails dans un dossier. Jusqu'à la tout va bien.
Le problème c'est le message de confirmation d'accès qui s'ouvre quand j'execute la marco.
Comment je peut faire pour l'enlever ?

voici mon code pour le parcour de la boite :

Code :

1
2
3
4
5
6
7
8
9
10
 Dim olApp As Outlook.Application
Dim Item As Outlook.MailItem
Dim Inbox As Outlook.MAPIFolder
 
Set olApp = Outlook.Application
Set Inbox = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
 
For Each Item In Inbox.Items
       '''code pour archivage
Next Item

Merci d'avance pour votre aide

[Oliv-]

Salut,
Mais tu executes ton code à partir de quel logiciel ? ca doit pas être OUTLOOK ?

Sur quelle instruction cela se declenche t'il ?

[bryony]

Si c'est du VBA outlook. Pour l'instant je le lance manuellement :
outil->marco->macro...
Il se déclenchera à l'ouverture d'outlook quand ça sera terminé.

Une idée pour enlever cette confirmation d'acces ?

[Oliv-]

Sur quelle instruction cela se declenche t'il ?
utilises F8

[bryony]

Merci bcp de t'interesser à mon problème Oliv,

La confirmation se déclenche sur ce bou de code :
Item.SaveAs ItemOutputFileName

Je sauvgarde les mails dans des dossiers pour mon archivage...
au début je croyais que c'était le fait d'accéder à la boite qui le provoquait mais enfaite c'est cette ligne là...

[Oliv-]

Il doit y avoir autre chose dans ton code, chez moi pas de message ?

quelle version de outlook ?

[bryony]

j'ai outlook 2000

[Dolphy35]

Salut,

tu peux nous mettre ton code complet ainsi qu'une capture du message


Dolphy

[bryony]

Voila mon code :

Code :

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
Sub deplacerMail(Item As Outlook.MailItem, catNom As String)
    Dim ItemOutputFileName As String
    Dim oFSO As Scripting.FileSystemObject
    Dim OutputDirectory As String
 
    OutputDirectory = "C:\Documents and Settings\Bryony.PLANT\Bureau\archivage mails\racine\" & catNom & "\"
    objet = Item.Subject
    Set oFSO = New Scripting.FileSystemObject
 
    On Error GoTo Erreur
 
    If objet = "" Then
        objet = "(vide)"
    End If
 
    objet = Replace(objet, ":", " ")
    objet = Replace(objet, "/", " ")
    objet = Replace(objet, "\", " ")
    objet = Replace(objet, "*", " ")
    objet = Replace(objet, """", " ")
    objet = Replace(objet, "?", "")
 
    ItemOutputFileName = OutputDirectory & objet & ".msg"
    i = 1
    Do While oFSO.FileExists(ItemOutputFileName)
        i = i + 1
        ItemOutputFileName = OutputDirectory & objet & " " & i & ".msg"
    Loop
    Item.SaveAs ItemOutputFileName, OlSaveAsType.olMSG
 
    Exit Sub
 
Erreur:
    MsgBox ("Erreur lors du transfert du mail: " & objet)
 
End Sub

(comment ti fait pour mettre les balises de code ??)

ça vien de ma version d'outlook ?

[Oliv-]

Ton code est incomplet
si tu as

Sub deplacerMail(Item As Outlook.MailItem, catNom As String)

c'est que tu le lances à partir d'un autre code .

Non ?

[bryony]

oui, voici le sub qui le lance :

Code :

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
Sub achiveLesMails()
    Dim olApp As Outlook.Application
    Dim Item As Outlook.MailItem
    Dim ItemOutputFileName As String
    Dim objet As String
    Dim Inbox As Outlook.MAPIFolder
 
    Set olApp = Outlook.Application
    Set Inbox = olApp.GetNamespace("MAPI").Folders("Boîte aux lettres - PLANT, Bryony").Folders("Boîte de réception")
    numProjet = "50.3251"
 
    Dim cat As String
    Dim nom As String
 
    Dim i As Integer
    Dim j As Integer
    Dim f As Integer
    Dim l As Integer
    Dim k As Integer
 
    For Each Item In Inbox.Items
        On Error GoTo Erreur
        objet = Item.Subject
        If InStr(objet, numProjet) = 1 Then
            If InStr(objet, "ALE-INTERNE") <> O Then
                cat = "Internes"
                Call deplacerMail(Item, cat)
            ElseIf InStr(objet, "ALE") = Len(numProjet) + 3 Then
                cat = "Fournisseurs"
                j = 1
                For i = 1 To 3
                    j = InStr(j, objet, "-") + 1
                Next i
                f = 1
                For i = 1 To 4
                    f = InStr(f, objet, "-") + 1
                Next i
                l = Len(objet) - j
                k = Len(objet) - f
                l = l - k - 1
                nom = Mid(objet, j, l)
                chercheDossierFournisseur (nom)
                Call deplacerMail(Item, cat & "\" & nom)
            Else
                cat = "Clients"
                j = InStr(objet, " ") + 1
                f = InStr(objet, "-")
                l = Len(objet) - j
                k = Len(objet) - f
                l = l - k
                nom = Mid(objet, j, l)
                chercheDossierClient (nom)
                Call deplacerMail(Item, cat & "\" & nom)
            End If
        Else
            Call deplacerMail(Item, "inclassables")
        End If
Suite:
   Next Item
 
 
    MsgBox ("Transfert terminé")
 
    Exit Sub
 
Erreur:
    MsgBox ("Erreur de traitement du mail : " & Item.Subject)
    Resume Suite
 
 
End Sub

et le Sub chercheDossierFournisseur :

Code :

1
2
3
4
5
6
7
8
Sub chercheDossierFournisseur(nomFournisseur As String)
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject
    'Accède au dossier
    If Not oFSO.FolderExists("C:\Documents and Settings\Bryony.PLANT\Bureau\archivage mails\racine\fournisseurs\" & nomFournisseur) Then
        creerDossierFournisseur (nomFournisseur)
    End If
End Sub

et le Sub creerDossierFournisseur

Code :

1
2
3
4
5
Sub creerDossierFournisseur(nomFournisseur As String)
MkDir "C:\Documents and Settings\Bryony.PLANT\Bureau\archivage mails\racine\fournisseurs\" & nomFournisseur
MkDir "C:\Documents and Settings\Bryony.PLANT\Bureau\archivage mails\racine\fournisseurs\" & nomFournisseur & "\From"
MkDir "C:\Documents and Settings\Bryony.PLANT\Bureau\archivage mails\racine\fournisseurs\" & nomFournisseur & "\TO"
End Sub

il y a deux sub identique pour les clients.

[bryony]

je trouve tjrs pas de solution, ça viendrai de ma version d'outlook ?

[Oliv-]

SAlut,
Oui cela vient bien de ta version avec ol2003 cela fonctionne.

http://support.microsoft.com/kb/262701/en-us

tu peux utiliser des logiciels qui vont cliquer à ta place ::
Advanced Security for Outlook
http://www.mapilab.com/outlook/security/

Express ClickYes
http://www.express-soft.com/mailmate/clickyes.html

Outlook Security Manager
http://www.add-in-express.com/outlook-security/?mapilab

[bryony]

ok,
en tout cas merci Oliv et Dolphy35 pour votre aide.

J'ai une autre question :
Es que c'est possible de changer l'objet d'un mail dans la boite ?
J'ai essayé ça : Item.Subject = "archi-" & Item.Subject
mais ça marche pas...

[Oliv-]

oui ajoute

Code :

item.save

après
ok ?

[bryony]

Merci !!!!
Je suis nul, je galère pour des conneries...

je voudrais pas abuser mais tu peux me dire que si c'est normal que "Item.Delete" ne marche que sur certains mails dans ma boucle ???

[bryony]

En faite pour la suppression j'ai trouvé le problème :
c'est que j'utilisais une boucle "for each....Next"
et il y faut pas. Apparemment il faut utiliser une boucle "for i=n to m....Next i"

Deplus si on fait des suppression il faut faire une boucle de pas -1 en partant de la fin "for i=inbox.items.count to 1 step -1", car la borne de fin (càd le nombre de mails) change à chaque suppression...

Voilà,
en tout cas merci pour votre aide.

[Oliv-]

Oui effectivement.

De plus il me semble que la suppression envoi vers les élements supprimés.