IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Outlook Discussion :

Fermeture de fichier PST par VBA [OL-2010]


Sujet :

VBA Outlook

  1. #1
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Fermeture de fichier PST par VBA
    Bonjour à toutes et tous

    Suite à la migration de mails dans un seul système, je dois écrire un script qui retire les fichiers PST des comptes utilisateurs.
    Cela fonctionne bien si le nom du fichier existe ou n'est pas corrompu.

    Si ce n'est pas le cas, Rien ne se passe. Le nom apparait dans le naviguation pane mais pas dans le compte mail (control panel).

    Manuellement, il suffit de faire un right clic sur le nom et de choisir "fermer ... xxx" où 'xxx' est le nom. Il se retire de la liste. OK ...

    J'aimerais faire la même chose, mais en VBA.
    Comment?
    Merci d'avance de votre aide
    André

    PS: J'utilise "objOL.Session.RemoveStore objFolder".
    Cela fonctionne si tout est ok.
    Par contre, cela ne fonctionne pas en cas de soucis. Aucune erreur. En pas à pas, l'instruction s'exécute mais sans erreurs.

  2. #2
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Bonjour,

    Tu veux supprimer les pst des comptes + du navigation pane ?
    Ce serait plus simple si tu publiais tout ton script.

  3. #3
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Voici mon code:
    Bonjour,
    Merci de votre réaction rapide.
    Comme dit l'intitulé, voici mon code:

    PS:
    J'ai mis ce code dans un fichier Excel
    Ne pas oublier d'ajouter dans les références : "Microsoft Outlook 14.0 Object Library"
    La feuille du fichier excel doit s'appeler : Status

    1er code:

    Celui-ci extrait la liste de tous les fichiers pst qui existe pour un utilisateur.
    Je doit supprimer tous ceux qui sont <> de "Serveur" doivent être supprimé.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    Sub PstFiles()
        Dim f As MAPIFolder
        Dim feuille As Worksheet
        Dim rw As Integer
     
        Dim rep As Boolean
        Dim nom As String
     
        Set feuille = ActiveWorkbook.Worksheets("Status")
     
        feuille.Cells(1, 2) = Application.UserName               ' Nom de l'utilisateur
        feuille.Cells(2, 2) = Environ$("computername")        ' Nom de l'ordinateur
        rw = LstRows(feuille, "B")
        If rw > 4 Then
            feuille.Range("B5:D" & rw).ClearContents           ' Enlève les anciennes données
        Else
            feuille.Range("B5:D5").ClearContents
        End If
     
        rw = 5   ' N° de ligne pour écrire le résultat dans la feuille Excel
     
        For Each f In Session.Folders
            nom = f.Name
            rep = False
            repertoire = GetPathFromStoreID(f.StoreID)  ' J'extrait le répertoire du fichier PST
            If repertoire <> "Server" Then
                reponse = MsgBox("do you want to remove " & nom & "?", vbQuestion + vbYesNo, "Question")
                If reponse Then
                    rep = RemovePST(nom)    ' Fonction qui retire le fichier PST
                End If
            End If
            feuille.Cells(rw, 2) = nom              ' Affiche les résultats
            feuille.Cells(rw, 3) = repertoire
            If rep Then
                feuille.Cells(rw, 4) = 1               ' La valeur 1 indique que le fichier est supprimé
            ElseIf repertoire = "Server" Then
                feuille.Cells(rw, 4) = "N/A"          ' Dans le cas ou le fichier est sur le serveur, il ne faut pas supprimer donc : N / A
            Else
                feuille.Cells(rw, 4) = -1              ' La valeur -1 indique que le fichier n'est pas supprimé
            End If
            rw = rw + 1
        Next f
    End Sub
     
     
    2° code: 
    Extrait le répertoire du fichier PST
     
    Public Function GetPathFromStoreID(sStoreID As String) As String
        On Error Resume Next
        Dim i As Long
        Dim lPos As Long
        Dim sRes As String
     
        For i = 1 To Len(sStoreID) Step 2
            sRes = sRes & Chr("&h" & Mid$(sStoreID, i, 2))
        Next
     
        sRes = Replace(sRes, Chr(0), vbNullString)
        lPos = InStr(sRes, ":\")
     
        If lPos Then
            GetPathFromStoreID = Right$(sRes, (Len(sRes)) - (lPos - 2))
        Else
            GetPathFromStoreID = "Server"
        End If
    End Function
     
    3ème code :
    ' Efface de la liste le fichier PST (passé en paramètre)
     
    Function RemovePST(PstName As String) As Boolean
        Dim objOL As Outlook.Application     'As New Outlook.Application
        Dim objFolders As Outlook.Folders    'As Outlook.MAPIFolders
        Dim objFolder As Outlook.MAPIFolder  'As Outlook.MAPIFolder
     
        Dim i 'As Interger
        Dim strPrompt 'As String
     
        Set objOL = CreateObject("Outlook.Application")
        Set objFolders = objOL.Session.Folders
     
        On Error Resume Next
     
        For i = objFolders.Count To 1 Step -1
            Set objFolder = objFolders.Item(i)
     
            If (InStr(1, objFolder.Name, "Mailbox") = 0) And (InStr(1, objFolder.Name, "Public Folders") = 0) And LCase(Trim(PstName)) = LCase(Trim(objFolder.Name)) Then
                objOL.Session.RemoveStore objFolder
     
                RemovePST = True
                Exit Function
            Else
                RemovePST = False
            End If
        Next i
    End Function

  4. #4
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Bonjour,
    En fait j'ai pas bien compris ce qui ne va pas.

    Mais voici le code que j'utilise pour supprimer un pst de outlook

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Function DetachPST(astrDisplayName As String) As Boolean
    ''=======================================================================
    ''  This routine used the received display name to close an existing pst
    ''  file
    ''  author :Henry Happ
    ''=======================================================================
        On Error GoTo Proc_Err
        Dim objNS As Outlook.NameSpace
        Dim objFolder As Outlook.MAPIFolder
     
        Set objNS = Application.GetNamespace("MAPI")
        Set objFolder = objNS.folders.item(astrDisplayName)
        objNS.RemoveStore objFolder
     
        '' Return success code
        DetachPST = True
     
    Proc_Exit:
        If Not objFolder Is Nothing Then Set objFolder = Nothing
        If Not objNS Is Nothing Then Set objNS = Nothing
        Exit Function
     
    Proc_Err:
        MsgBox Err.Description, , "DetachPST"
        DetachPST = False
        GoTo Proc_Exit
     
    End Function

  5. #5
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Voici la situation
    Bonjour,
    Pour commencer, j'aimerais m'excuser de ma réaction tardive. Mais ma charge de travail m'a empêché de le faire.
    Ensuite, merci de m'aider.

    Pour finir, j'essaie d'utiliser votre code et cela m'est impossible. Il refuse le MAPI. Il ne se trouve pas dans les références du VBA.
    J'ai un peu regardé sur internet et essayé de télécharger les fichiers nécessaires. Vu que je ne suis pas administrateur de ma machine, le département IT ne voudras surement pas l'installer.

    Pour mieux comprendre mon problème, je vais essayer de l'expliquer plus simplement.

    En début juillet, notre entreprise décide de vouloir intégrer tous les fichiers PST dans un environnement Exchange unique.
    Ensuite, il supprime les fichiers PST existant. Il me demande d'écrire le script pour faire ce travail.
    Tous fonctionne bien pour 99% des cas. Il reste 1%.

    Ce sont des gens qui sauvent leurs fichiers PST sur des disques dur externe, clef USB, etc...
    Résultat, dans Outlook,j'ai une liste (dans le navigation pane) qui ne correspond pas avec la réalité (Il ne trouve pas le fichier).

    Pour ce faire, je dois simplement faire un clic droit sur la boite mail qui n'est lié à rien et faire "close xxx" où xxx est le nom de la boite mail.
    Manuellement, cela fonctionne très bien.

    Les macros que j'ai mis en ligne ne "plante" pas. mais il ne se passe rien.
    Comment faire cela ?

    Lorsque je lis votre code, vous utiliser la même commande que moi. Et donc, je crains que cela ne fonctionnera pas.

    Merci d'avoir passer votre temps pour m'aider.

    Si jamais quelqu'un sait m'aider, cela serait merveilleux. Je m'arrache mes derniers cheveux gris !
    André

  6. #6
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    SAlut,

    Donc quand le fichier pst existe à l'emplacement prévu c'est ok, mais quand il n'existe pas cela ne marche pas ! c'est bien cela ?

    Mon code plante parce qu'il est purement outlook, et comem tu lances cela de EXCEL il faut un peu le modifier.

    Je regarde cela

    PS: ne serait il pas plus simple de recréer un profil OUTLOOK complet avec uniquement le COMPTE EXCHANGE ?

  7. #7
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Réponse
    Bonjour,
    A ta première remarque :oui c'est correct
    Deuxième remarque: Dans Excel, il suffit d'ajouter dans les références "Microsoft Outlook 14.0 Object Library".
    Pour ton PS: Là je ne suis pas un grand champion. Si t'as quelques idées ...

    Merci encore
    André

  8. #8
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Euh non il ne faut pas juste ajouter la reférence il OL il faut déclarer un objet
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set objOL = CreateObject("Outlook.Application")
    et remplacer application. par objOL.

    Sinon j'ai un code qui fait le job, mais il faut installer REDEMPTION
    http://www.dimastr.com/redemption/download.htm

    Qui est gratuit pour les développeurs (mais il affiche une boite de dialogue d'acceptation de licence au premier lancement.)


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    Sub rdo_remove_deleted_pst()
        Set RDOSession = CreateObject("Redemption.RDOSession")
        RDOSession.MAPIOBJECT = Application.Session.MAPIOBJECT
        Set Store = RDOSession.Stores("Test@test.com")
        Store.Remove
    End Sub

  9. #9
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Essaye cette autre méthode

    En fait il faut créer au préalable un fichier PST vide ou pas très gros pour que cela aille vite.
    et on va faire un copier/coller à l'emplacement attendu par OUTLOOK.

    Dans le cas de pst qui se trouvaient sur des lecteurs deconnectés, il faudrait recréer le lecteur...(en tout cas virtuellement)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    Sub PstFiles()
        Dim f As MAPIFolder
        Dim feuille As Worksheet
        Dim rw As Integer
     
        Dim rep As Boolean
        Dim nom As String
     
        Set feuille = ActiveWorkbook.Worksheets("Status")
     
        feuille.Cells(1, 2) = Application.UserName    ' Nom de l'utilisateur
        feuille.Cells(2, 2) = Environ$("computername")    ' Nom de l'ordinateur
        rw = 4    '#################### LstRows(feuille, "B")
        If rw > 4 Then
            feuille.Range("B5" & rw).ClearContents    ' Enlève les anciennes données
        Else
            feuille.Range("B55").ClearContents
        End If
     
        rw = 5    ' N° de ligne pour écrire le résultat dans la feuille Excel
     
        Dim objOL As Outlook.Application
        Dim objFolders As Outlook.Folders    'As Outlook.MAPIFolders
        Set objOL = CreateObject("Outlook.Application")
        Set objFolders = objOL.Session.Folders
     
        For i = objFolders.Count To 1 Step -1
            Set f = objFolders(i)
            nom = f.Name
            rep = False
            On Error Resume Next
            repertoire = GetPathFromStoreID(f.StoreID)    ' J'extrait le répertoire du fichier PST
            On Error GoTo 0
            If repertoire <> "Server" Then
                reponse = MsgBox("do you want to remove " & nom & "?", vbQuestion + vbYesNo, "Question")
                If reponse = vbYes Then
                    'rep = RemovePST(nom)    ' Fonction qui retire le fichier PST
                    rep = DetachPST(nom, objOL)
                End If
            End If
            feuille.Cells(rw, 2) = nom    ' Affiche les résultats
            feuille.Cells(rw, 3) = repertoire
            If rep Then
                feuille.Cells(rw, 4) = 1    ' La valeur 1 indique que le fichier est supprimé
            ElseIf repertoire = "Server" Then
                feuille.Cells(rw, 4) = "N/A"    ' Dans le cas ou le fichier est sur le serveur, il ne faut pas supprimer donc : N / A
            Else
                feuille.Cells(rw, 4) = -1    ' La valeur -1 indique que le fichier n'est pas supprimé
            End If
            rw = rw + 1
            repertoire = ""
        Next i
    End Sub
     
     
    '2 ° code:Extrait le répertoire du fichier PST
     
    Public Function GetPathFromStoreID(sStoreID As String) As String
        On Error Resume Next
        Dim i As Long
        Dim lPos As Long
        Dim sRes As String
     
        For i = 1 To Len(sStoreID) Step 2
            sRes = sRes & Chr("&h" & Mid$(sStoreID, i, 2))
        Next
     
        sRes = Replace(sRes, Chr(0), vbNullString)
        lPos = InStr(sRes, ":\")
     
        If lPos Then
            GetPathFromStoreID = Right$(sRes, (Len(sRes)) - (lPos - 2))
        Else
            GetPathFromStoreID = "Server"
        End If
    End Function
     
    ''3 ème code:' Efface de la liste le fichier PST (passé en paramètre)
    '
    'Function RemovePST(PstName As String) As Boolean
    '    Dim objOL As Outlook.Application    'As New Outlook.Application
    '    Dim objFolders As Outlook.Folders    'As Outlook.MAPIFolders
    '    Dim objFolder As Outlook.MAPIFolder    'As Outlook.MAPIFolder
    '
    '    Dim i    'As Interger
    '    Dim strPrompt    'As String
    '
    '    Set objOL = CreateObject("Outlook.Application")
    '    Set objFolders = objOL.Session.Folders
    '
    '    On Error Resume Next
    '
    '    For i = objFolders.Count To 1 Step -1
    '        Set objFolder = objFolders.Item(i)
    '
    '        If (InStr(1, objFolder.Name, "Mailbox") = 0) And (InStr(1, objFolder.Name, "Public Folders") = 0) And LCase(Trim(PstName)) = LCase(Trim(objFolder.Name)) Then
    '            objOL.Session.RemoveStore objFolder
    '
    '            RemovePST = True
    '            Exit Function
    '        Else
    '            RemovePST = False
    '        End If
    '    Next i
    'End Function
     
    Function DetachPST(astrDisplayName As String, OLAPP As Object) As Boolean
    ''=======================================================================
    ''  This routine used the received display name to close an existing pst
    ''  file
    ''  author :Henry Happ
    ''=======================================================================
        On Error GoTo Proc_Err
        Dim objNS As Outlook.Namespace
        Dim objFolder As Outlook.Folder
     
        Set objNS = OLAPP.GetNamespace("MAPI")
        Set objFolder = objNS.Folders.Item(astrDisplayName)
        MsgBox objFolder.FolderPath
        objNS.RemoveStore objFolder
     
        '' Return success code
        DetachPST = True
     
    Proc_Exit:
        If Not objFolder Is Nothing Then Set objFolder = Nothing
        If Not objNS Is Nothing Then Set objNS = Nothing
        Exit Function
     
    Proc_Err:
        MsgBox Err.Number & "-" & Err.Description, , "DetachPST"
        If InStr(1, Err.Description, "Impossible de trouver le fichier ", vbTextCompare) > 0 Then
        Path = Replace(Err.Description, "Impossible de trouver le fichier ", "", , , vbTextCompare)
        Dim FSO
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.CopyFile "c:\Essai\MonPSTVIDE.pst", Path, True
        Resume
        Stop
        DetachPST = False
     
        GoTo Proc_Exit
     
    End Function
    une autre méthode pour supprimer tous les stores qui ne sont pas des exchange.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Sub storedetachpst()
       ' On Error Resume Next
        Dim objOutlook    'As Outlook.Application
        Dim Stores     'As Outlook.Stores
        Dim objFolder  'As Outlook.Folder
        Dim i          'As Integer
     
        Set objOutlook = CreateObject("Outlook.Application")
        Set Stores = objOutlook.Session.Stores
     
     
        For i = Stores.Count To 0 Step -1
            Debug.Print Stores(i)
            Stores(i).Delete
            If Stores(i).ExchangeStoreType = 3 Then
                Set objFolder = Stores(i).GetRootFolder
                reponse = MsgBox("do you want to remove " & objFolder & "?", vbQuestion + vbYesNo, "Question")
                If reponse = vbYes Then
                    objOutlook.Session.RemoveStore objFolder
                End If
            Else
            End If
            Set objFolder = Nothing
        Next
    End Sub

  10. #10
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Situation
    Bonjour,
    J'aimerais vous remercier pour le temps que vous donner pour m'aider.

    L'idée de créer un fichier PST vide n'est pas mauvaise.

    Mais j'attrape l'erreur : Method 'CopyFile' of object 'IFileSystem3" failed
    sur l'instruction : FSO.CopyFile "C:\LocalPrograms\Temp\andré\MonPSTVIDE.pst", Path, True

    J'ai regardé si le VBScripting est bien activé. Ce qui est le cas.

    Autre remarque: j'ai dû un peu modifier le code car j'ai office en Anglais.

    Donc, sur mon H drive, j'ai crée un fichier PST vide que j'ai appelé "test.pst" et que j'ai ajouté dans l'email account (via le control panel).
    "test" apparait dans le navigation pane d'Outlook. Je ferme Outlook, et je renomme le fichier test.pst en test1.pst.
    Et j'ouvre outlook. test apparait toujours dans le navigation pane.

    Maintenant, j’exécute, en pas à pas, votre code.
    Il s'arrête dans "proc_err" puisqu'il ne trouve pas le fichier. OK.

    Si j'affiche le contenu de Err.Description, je reçois : "The file H:\test.pst cannot be found." Ce qui est logique.
    J'ai modifié la variable "Path" pour enlever le texte Anglais afin qu'elle me donne comme résultat final: H:\test.pst
    Ensuite, je crée un fichier PST vide que je recopie. Et là, arrive l'erreur "Method 'CopyFile' of object 'IFileSystem3" failed "

    Le nouveau fichier (C:\LocalPrograms\Temp\andré\MonPSTVIDE.pst) est bien crée et se trouve bien dans le navigation pane.


    voici la partie du code que j'ai modifié. Ah oui, à la première exécution, il manquait un End IF. J'espère l'avoir mis au bon endroit.
    (juste après le stop).

    Merci encore
    André

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Proc_Err:
        MsgBox Err.Number & "-" & Err.Description, , "DetachPST"
        If InStr(1, Err.Description, "cannot be found.", vbTextCompare) > 0 Then
     
            Path = Replace(Err.Description, " cannot be found.", "", , , vbTextCompare)
            Path = Replace(Path, "The file ", "", , , vbTextCompare)
     
            objNS.AddStoreEx "C:\LocalPrograms\Temp\andré\MonPSTVIDE.pst", olStoreUnicode
     
            Dim FSO
            Set FSO = CreateObject("Scripting.FileSystemObject")
            FSO.CopyFile "C:\LocalPrograms\Temp\andré\MonPSTVIDE.pst", Path, True
            Resume
            Stop
        End If
     
        DetachPST = False
        GoTo Proc_Exit

  11. #11
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Bonjour André,
    C'est mieux si tu utilises les balises codes c'est l'icone # au dessus.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Proc_Err:
    MsgBox Err.Number & "-" & Err.Description, , "DetachPST"
    If InStr(1, Err.Description, "cannot be found.", vbTextCompare) > 0 Then
    
    Path = Replace(Err.Description, " cannot be found.", "", , , vbTextCompare)
    Path = Replace(Path, "The file ", "", , , vbTextCompare)
    
    ' CETTE LIGNE EST INUTILE objNS.AddStoreEx "C:\LocalPrograms\Temp\andré\MonPSTVIDE.pst", olStoreUnicode
    
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.CopyFile "C:\LocalPrograms\Temp\andré\MonPSTVIDE.pst", Path, True
    Resume
    Stop
    End If
    
    DetachPST = False
    GoTo Proc_Exit
    c'est sans doute la ligne "INUTILE" qui cause ton problème car du coup le fichier est utilisé.
    Le but c'est pas d'ajouter le pst dans outlook c'est de lui permettre de trouver celui qu'on veut supprimer.

  12. #12
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Réponse
    Bonjour,

    Désolé. Je suis nouveau sur ce forum. Je ne savais pas.
    Mais pas de souci. Je ferais tous ce que vous me dites.

    J'ai essayé le code sans la ligne excédante mais sans succès. Le problème reste le même.

    Code vba : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    FSO.CopyFile "C:\LocalPrograms\Temp\andré\MonPSTVIDE.pst", Path, True
    erreur : "Method 'CopyFile' of object 'IFileSystem3" failed"

    Andre

  13. #13
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Peux tu publier le contenu de la variable "path" ?
    c'est soit un problème de fichier ouvert, ou de caractères non valide dans le nom

  14. #14
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Suite ..
    bonjour,
    Voici la variable path
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    PATH=C:\LocalPrograms\Oracle\product\11.2.0\client_x86\bin;C:\PGM\oracle\product\11.2.0\client_x86\bin;C:\windows\system32;C:\windows;C:\windows\System32\Wbem;C:\windows\System32\WindowsPowerShell\v1.0\;C:\windows\idmu\common;C:\Program Files (x86)\QuickTime\QTSystem\;C:\PGM\ZANTAZ\EAS Outlook Addin 6.4.0.2\bin;C:\Program Files (x86)\Common Files\PowerSoft Shared;C:\Program Files (x86)\Microsoft Application Virtualization Client;C:\windows\System32\WindowsPowerShell\v1.0\;C:\LocalPrograms\TortoiseSVN\TortoiseSVN-1.8.1\bin;C:\Program Files (x86)\Java\jre6\Bin
    Merci

    André

  15. #15
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    On n'a pas du se comprendre, c'est pas la varialbe locale de windows que je voulais mais celle de la macro;

    Pour pas qu'il y ait d'embrouille

    Change dans le code de la macro

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Function DetachPST(astrDisplayName As String, OLAPP As Object) As Boolean
    ''=======================================================================
    ''  This routine used the received display name to close an existing pst
    ''  file
    ''  author :Henry Happ
    ''=======================================================================
        On Error GoTo Proc_Err
        Dim objNS As Outlook.Namespace
        Dim objFolder As Outlook.Folder
        
        Dim MonPath as string
     
        Set objNS = OLAPP.GetNamespace("MAPI")
        Set objFolder = objNS.Folders.Item(astrDisplayName)
        MsgBox objFolder.FolderPath
        objNS.RemoveStore objFolder
     
        '' Return success code
        DetachPST = True
     
    Proc_Exit:
        If Not objFolder Is Nothing Then Set objFolder = Nothing
        If Not objNS Is Nothing Then Set objNS = Nothing
        Exit Function
     
    Proc_Err:
        MsgBox Err.Number & "-" & Err.Description, , "DetachPST"
       If InStr(1, Err.Description, "cannot be found.", vbTextCompare) > 0 Then
    
    MonPath = Replace(Err.Description, " cannot be found.", "", , , vbTextCompare)
    MonPath = Replace(Path, "The file ", "", , , vbTextCompare)
    
    debug.print MonPath
    
        Dim FSO
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.CopyFile "c:\Essai\MonPSTVIDE.pst", MonPath, True
        Resume
        Stop
        DetachPST = False
     
        GoTo Proc_Exit
     
    End Function

  16. #16
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut réponse
    Bonjour,

    Désolé ...

    Alors, lorsque le code entre dans la fonction "DetachPST", voici le contenu des variables:

    astrDisplayName : test

    Lorsqu'il arrive sur l'instruction :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set objFolder = objNS.Folders.Item(astrDisplayName)
    il y a erreur (logique puisque le fichier n'existe pas).

    La sous routine Proc_Err est appelée.

    Err.Description contient : The file H:\test.pst cannot be found.

    je retire le texte "The file" et " cannot be found" et la variable Path contiendra : H:\test.pst
    André

  17. #17
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    ok très bien.
    et est ce que le lecteur H:\ existe bien ?

  18. #18
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut réponse
    Bonjour,

    Oui, le H drive existe bien.
    André

  19. #19
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 087
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 087
    Points : 7 168
    Points
    7 168
    Billets dans le blog
    20
    Par défaut
    Bonjour,
    Peux tu essayer avec un dossier sur ton c:\

  20. #20
    Membre régulier
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Juin 2015
    Messages
    198
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Juin 2015
    Messages : 198
    Points : 80
    Points
    80
    Par défaut Reponse
    Bonjour,
    Je viens d'essayer sur mon C drive.
    Le problème est identique.

    André

+ Répondre à la discussion
Cette discussion est résolue.
Page 1 sur 2 12 DernièreDernière

Discussions similaires

  1. [AC-2003] Remise en forme d'un fichier Excel Par VBA (Access)
    Par Deustalos dans le forum VBA Access
    Réponses: 6
    Dernier message: 09/11/2009, 10h45
  2. [XL-2007] Probleme de après l'enregitrement de fichiers compatibles par VBA excel
    Par Jessyline dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 13/07/2009, 17h38
  3. Appel fichier excel par vba
    Par wachoo31 dans le forum VBA Access
    Réponses: 2
    Dernier message: 05/04/2009, 12h13
  4. Renommer fichier excel par vba
    Par lucazzo dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 19/07/2008, 13h20
  5. Propriété fichiers MP3 par VBA Excel
    Par AIFOL dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 20/01/2008, 23h46

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo