Sous VBA comment modifier le code (extrait) ci-dessous
pour que lorsque le programme rencontre un fichier
d'un nom déjà existant il offre le choix entre l'écraser
ou ne pas l'enregistrer ?
Merci d'avance.
--
a+ Jean-Pol Site Web : www.colovid.be
Site Web perso pour le fun : http://users.skynet.be/DAVID/
Cette page est transmise avec des électrons 100% recyclés.
Public disk As Integer, Chemin As String
Dim FichierBon As Boolean
'---------------------------------------------------------------------------------------------
Sub CopierFichierJoint()
Dim OutlookApp As New Outlook.Application
Dim OutlookExp As Outlook.Explorer
Dim OutlookSélex As Outlook.Selection
Dim x As Integer
Dim i As Integer
Dim NomFichier As String
Dim NomFichierTemp As String
Dim DossierDestination As String
Dim DossierParDéfaut As String
Dim DateRéception As String
Dim fs
'Procedure de traitement des messages
Dim folder As String
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
ChoixDuDisk.Show
Select Case disk
Case 1
Choix = ChoixDossierFichier("D:\")
Case 2
Choix = ChoixDossierFichier("K:\")
Case 3
On Error Resume Next
Dir ("A:")
If Err.Number = 52 Then
MsgBox "Pas de disquette dans le lecteur, introduisez une
disquette vierge dans le lecteur.", vbOKOnly, "Erreur"
End
End If
Choix = ChoixDossierFichier("A:\")
If Choix = "" Then Choix = "A:"
Case 4
Choix = ChoixDossierFichier("L:\")
End Select
If Choix = "" Then End
ChoixDuDisk.Hide
DossierParDéfaut = Choix & "\"
DossierDestination = DossierParDéfaut
Set fs = CreateObject("Scripting.FileSystemObject")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookExp = OutlookApp.ActiveExplorer
Set OutlookSélex = OutlookExp.Selection
If OutlookSélex.Count < 1 Then
MsgBox "Aucun message n'est sélectionné.", vbExclamation,
"Erreur"
Exit Sub
End If
For x = 1 To OutlookSélex.Count
DoEvents
DateRéception = OutlookSélex.Item(x).ReceivedTime
NomFichier = OutlookSélex.Item(x)
NomFichier = NomFichier & " (" & DateRéception & ")"
NomFichier = Remplacement(NomFichier, "/", ".")
NomFichier = Remplacement(NomFichier, "\", "_")
NomFichier = Remplacement(NomFichier, ":", ".")
NomFichier = Remplacement(NomFichier, "*", "_")
NomFichier = Remplacement(NomFichier, "?", "_")
NomFichier = Remplacement(NomFichier, Chr(34), "_")
NomFichier = Remplacement(NomFichier, "<", "_")
NomFichier = Remplacement(NomFichier, ">", "_")
NomFichier = Remplacement(NomFichier, "|", "_")
i = 1
NomFichierTemp = NomFichier
On Error GoTo Erreur
Set myItem = OutlookSélex.Item(x)
If myItem.Attachments.Count > 0 Then
For pi = 1 To myItem.Attachments.Count
Set myAttachments = myItem.Attachments
'sauvegarde du piece attachee
myAttachments.Item(pi).SaveAsFile DossierDestination
& "\" _
& myAttachments.Item(pi).DisplayName
FichierBon = True
Next
Else
MsgBox "Le message " & NomFichier & " ne contient pas de
fichier joint.", vbExclamation, "Message d'avertissement"
End If
Do While fs.FileExists(DossierDestination & NomFichier & ".msg")
= True
NomFichier = NomFichierTemp & " - " & i
i = i + 1
Loop
Next x
If FichierBon = True Then MsgBox "Sauvegarde des pièces jointes
terminée", vbInformation, "Enregistrement"
GoTo Fin
End
Erreur:
MsgBox "Le dossier que vous avez indiqué (" & DossierDestination &
") n'existe pas." _
& Chr(10) & "Les messages n'ont pas été copiés.", vbOKOnly, "Erreur"
Fin:
FichierBon = False
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Geo
Bonsoir Jean-Paul
Sous VBA comment modifier le code (extrait) ci-dessous pour que lorsque le programme rencontre un fichier d'un nom déjà existant il offre le choix entre l'écraser ou ne pas l'enregistrer ?
Faudra dire au programmeur de mettre des commentaires dans ses programmes ce serait plus simple pour les modifier.
Je tenterais une modification comme ceci : 'sauvegarde du piece attachee Dim NomPj As String Dim Réponse As Long NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then Réponse = MsgBox("Le fichier " & vbCrLf & NomPj & _ vbCrLf & " existe déjà. L'écraser ?", vbYesNo) If Réponse = vbYes Then ' on l'écrase myAttachments.Item(Pi).SaveAsFile NomPj Else ' ignorer ' prévoir un message ? End If Else myAttachments.Item(Pi).SaveAsFile NomPj End If FichierBon = True Pour se repérer, j'ai gardé la ligne qui précède et celle qui suit.
Pas testé, évidemment.
-- A+
Bonsoir Jean-Paul
Sous VBA comment modifier le code (extrait) ci-dessous
pour que lorsque le programme rencontre un fichier
d'un nom déjà existant il offre le choix entre l'écraser
ou ne pas l'enregistrer ?
Faudra dire au programmeur de mettre des commentaires dans ses
programmes ce serait plus simple pour les modifier.
Je tenterais une modification comme ceci :
'sauvegarde du piece attachee
Dim NomPj As String
Dim Réponse As Long
NomPj = DossierDestination & "" _
& myAttachments.Item(Pi).DisplayName
myAttachments.Item(Pi).SaveAsFile NomPj
If fs.FileExists(NomPj) Then
Réponse = MsgBox("Le fichier " & vbCrLf & NomPj & _
vbCrLf & " existe déjà. L'écraser ?", vbYesNo)
If Réponse = vbYes Then
' on l'écrase
myAttachments.Item(Pi).SaveAsFile NomPj
Else
' ignorer
' prévoir un message ?
End If
Else
myAttachments.Item(Pi).SaveAsFile NomPj
End If
FichierBon = True
Pour se repérer, j'ai gardé la ligne qui précède et celle qui suit.
Sous VBA comment modifier le code (extrait) ci-dessous pour que lorsque le programme rencontre un fichier d'un nom déjà existant il offre le choix entre l'écraser ou ne pas l'enregistrer ?
Faudra dire au programmeur de mettre des commentaires dans ses programmes ce serait plus simple pour les modifier.
Je tenterais une modification comme ceci : 'sauvegarde du piece attachee Dim NomPj As String Dim Réponse As Long NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then Réponse = MsgBox("Le fichier " & vbCrLf & NomPj & _ vbCrLf & " existe déjà. L'écraser ?", vbYesNo) If Réponse = vbYes Then ' on l'écrase myAttachments.Item(Pi).SaveAsFile NomPj Else ' ignorer ' prévoir un message ? End If Else myAttachments.Item(Pi).SaveAsFile NomPj End If FichierBon = True Pour se repérer, j'ai gardé la ligne qui précède et celle qui suit.
Pas testé, évidemment.
-- A+
David
Bonjour Geo,
Merci pour la peine que vous vous êtes donné. Pas facile de rentrer dans un programme dont on n'est pas le créateur. Merci en tout cas.
-- a+ Jean-Pol Site Web : www.colovid.be Site Web perso pour le fun : http://users.skynet.be/DAVID/ Cette page est transmise avec des électrons 100% recyclés.
"Geo" a écrit dans le message de news:
Bonsoir Jean-Paul
Sous VBA comment modifier le code (extrait) ci-dessous pour que lorsque le programme rencontre un fichier d'un nom déjà existant il offre le choix entre l'écraser ou ne pas l'enregistrer ?
Faudra dire au programmeur de mettre des commentaires dans ses programmes ce serait plus simple pour les modifier.
Je tenterais une modification comme ceci : 'sauvegarde du piece attachee Dim NomPj As String Dim Réponse As Long NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then Réponse = MsgBox("Le fichier " & vbCrLf & NomPj & _ vbCrLf & " existe déjà. L'écraser ?", vbYesNo) If Réponse = vbYes Then ' on l'écrase myAttachments.Item(Pi).SaveAsFile NomPj Else ' ignorer ' prévoir un message ? End If Else myAttachments.Item(Pi).SaveAsFile NomPj End If FichierBon = True Pour se repérer, j'ai gardé la ligne qui précède et celle qui suit.
Pas testé, évidemment.
-- A+
Bonjour Geo,
Merci pour la peine que vous vous êtes donné.
Pas facile de rentrer dans un programme dont
on n'est pas le créateur.
Merci en tout cas.
--
a+ Jean-Pol
Site Web : www.colovid.be
Site Web perso pour le fun : http://users.skynet.be/DAVID/
Cette page est transmise avec des électrons 100% recyclés.
"Geo" <Geo@sans.pub> a écrit dans le message de news:
mn.64b37d9411cc0714.41568@sans.pub...
Bonsoir Jean-Paul
Sous VBA comment modifier le code (extrait) ci-dessous
pour que lorsque le programme rencontre un fichier
d'un nom déjà existant il offre le choix entre l'écraser
ou ne pas l'enregistrer ?
Faudra dire au programmeur de mettre des commentaires dans ses programmes
ce serait plus simple pour les modifier.
Je tenterais une modification comme ceci :
'sauvegarde du piece attachee
Dim NomPj As String
Dim Réponse As Long
NomPj = DossierDestination & "" _
& myAttachments.Item(Pi).DisplayName
myAttachments.Item(Pi).SaveAsFile NomPj
If fs.FileExists(NomPj) Then
Réponse = MsgBox("Le fichier " & vbCrLf & NomPj & _
vbCrLf & " existe déjà. L'écraser ?", vbYesNo)
If Réponse = vbYes Then
' on l'écrase
myAttachments.Item(Pi).SaveAsFile NomPj
Else
' ignorer
' prévoir un message ?
End If
Else
myAttachments.Item(Pi).SaveAsFile NomPj
End If
FichierBon = True
Pour se repérer, j'ai gardé la ligne qui précède et celle qui suit.
Merci pour la peine que vous vous êtes donné. Pas facile de rentrer dans un programme dont on n'est pas le créateur. Merci en tout cas.
-- a+ Jean-Pol Site Web : www.colovid.be Site Web perso pour le fun : http://users.skynet.be/DAVID/ Cette page est transmise avec des électrons 100% recyclés.
"Geo" a écrit dans le message de news:
Bonsoir Jean-Paul
Sous VBA comment modifier le code (extrait) ci-dessous pour que lorsque le programme rencontre un fichier d'un nom déjà existant il offre le choix entre l'écraser ou ne pas l'enregistrer ?
Faudra dire au programmeur de mettre des commentaires dans ses programmes ce serait plus simple pour les modifier.
Je tenterais une modification comme ceci : 'sauvegarde du piece attachee Dim NomPj As String Dim Réponse As Long NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then Réponse = MsgBox("Le fichier " & vbCrLf & NomPj & _ vbCrLf & " existe déjà. L'écraser ?", vbYesNo) If Réponse = vbYes Then ' on l'écrase myAttachments.Item(Pi).SaveAsFile NomPj Else ' ignorer ' prévoir un message ? End If Else myAttachments.Item(Pi).SaveAsFile NomPj End If FichierBon = True Pour se repérer, j'ai gardé la ligne qui précède et celle qui suit.
Pas testé, évidemment.
-- A+
Geo
Re
Merci pour la peine que vous vous êtes donné. Pas facile de rentrer dans un programme dont on n'est pas le créateur.
Et on craint de casser autre chose.
Tenez-nous au courant.
-- A+
Re
Merci pour la peine que vous vous êtes donné.
Pas facile de rentrer dans un programme dont
on n'est pas le créateur.
Merci pour la peine que vous vous êtes donné. Pas facile de rentrer dans un programme dont on n'est pas le créateur.
Et on craint de casser autre chose.
Tenez-nous au courant.
-- A+
David
Bonjour Geo,
Et on craint de casser autre chose.
Exactement; c'est pour cela que j'ai préféré poser la question sur le forum :-)))
Votre code m'inspirant toute confiance je m'y suis cantonné malgré que cela ne fonctionnait pas. En effet, quelque soit le choix le fichier était à nouveau enregistré. Ce que je n'ai pas compris tout de suite - bien sûr.
Un ligne de code s'est en effet malicieusement infiltrée dans votre projet ici à hauteur de la flèche :
NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName -----> myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then
Ensuite, en lisant des pages sur Internet, j'ai supprimé ces quelques lignes du mon codes initiale :
'Do While fs.FileExists(DossierDestination & NomFichier & ".msg") = True ' NomFichier = NomFichierTemp & " - " & i ' i = i + 1 'Loop
Maintenant, ça à l'air de fonctionner.
Un grand merci car je pense que sans vous je n'y serais pas arrivé.
-- a+ Jean-Pol Site Web : www.colovid.be Site Web perso pour le fun : http://users.skynet.be/DAVID/ Cette page est transmise avec des électrons 100% recyclés.
"Geo" a écrit dans le message de news:
Re
Merci pour la peine que vous vous êtes donné. Pas facile de rentrer dans un programme dont on n'est pas le créateur.
Et on craint de casser autre chose.
Tenez-nous au courant.
-- A+
Bonjour Geo,
Et on craint de casser autre chose.
Exactement; c'est pour cela que j'ai préféré poser la
question sur le forum :-)))
Votre code m'inspirant toute confiance je
m'y suis cantonné malgré que cela ne fonctionnait pas.
En effet, quelque soit le choix le fichier était à nouveau
enregistré. Ce que je n'ai pas compris tout de suite - bien sûr.
Un ligne de code s'est en effet malicieusement infiltrée dans votre projet
ici à hauteur de la flèche :
NomPj = DossierDestination & "" _
& myAttachments.Item(Pi).DisplayName
-----> myAttachments.Item(Pi).SaveAsFile NomPj
If fs.FileExists(NomPj) Then
Ensuite, en lisant des pages sur Internet, j'ai supprimé
ces quelques lignes du mon codes initiale :
'Do While fs.FileExists(DossierDestination & NomFichier & ".msg") = True
' NomFichier = NomFichierTemp & " - " & i
' i = i + 1
'Loop
Maintenant, ça à l'air de fonctionner.
Un grand merci car je pense que sans vous je n'y serais pas arrivé.
--
a+ Jean-Pol
Site Web : www.colovid.be
Site Web perso pour le fun : http://users.skynet.be/DAVID/
Cette page est transmise avec des électrons 100% recyclés.
"Geo" <Geo@sans.pub> a écrit dans le message de news:
mn.65327d94d1177a7f.41568@sans.pub...
Re
Merci pour la peine que vous vous êtes donné.
Pas facile de rentrer dans un programme dont
on n'est pas le créateur.
Exactement; c'est pour cela que j'ai préféré poser la question sur le forum :-)))
Votre code m'inspirant toute confiance je m'y suis cantonné malgré que cela ne fonctionnait pas. En effet, quelque soit le choix le fichier était à nouveau enregistré. Ce que je n'ai pas compris tout de suite - bien sûr.
Un ligne de code s'est en effet malicieusement infiltrée dans votre projet ici à hauteur de la flèche :
NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName -----> myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then
Ensuite, en lisant des pages sur Internet, j'ai supprimé ces quelques lignes du mon codes initiale :
'Do While fs.FileExists(DossierDestination & NomFichier & ".msg") = True ' NomFichier = NomFichierTemp & " - " & i ' i = i + 1 'Loop
Maintenant, ça à l'air de fonctionner.
Un grand merci car je pense que sans vous je n'y serais pas arrivé.
-- a+ Jean-Pol Site Web : www.colovid.be Site Web perso pour le fun : http://users.skynet.be/DAVID/ Cette page est transmise avec des électrons 100% recyclés.
"Geo" a écrit dans le message de news:
Re
Merci pour la peine que vous vous êtes donné. Pas facile de rentrer dans un programme dont on n'est pas le créateur.
Et on craint de casser autre chose.
Tenez-nous au courant.
-- A+
Geo
Bonsoir Jean-Pol
Un ligne de code s'est en effet malicieusement infiltrée dans votre projet ici à hauteur de la flèche :
NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName -----> myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then
Vous avez tout à fait raison, j'ai omis de la supprimer.
Ensuite, en lisant des pages sur Internet, j'ai supprimé ces quelques lignes du mon codes initiale :
'Do While fs.FileExists(DossierDestination & NomFichier & ".msg") = True ' NomFichier = NomFichierTemp & " - " & i ' i = i + 1 'Loop
Ca a été ma grande interrogation hier. J'en suis arrivé à la conclusion que le message lui-même pouvait être enregistré dans ce dossier et pour éviter d'écraser un message par un autre de même "nom" on ajoutait des caractères derrière. Vous pourriez le vérifier dans le reste du code.
-- A+
Bonsoir Jean-Pol
Un ligne de code s'est en effet malicieusement infiltrée dans votre projet
ici à hauteur de la flèche :
NomPj = DossierDestination & "" _
& myAttachments.Item(Pi).DisplayName
-----> myAttachments.Item(Pi).SaveAsFile NomPj
If fs.FileExists(NomPj) Then
Vous avez tout à fait raison, j'ai omis de la supprimer.
Ensuite, en lisant des pages sur Internet, j'ai supprimé
ces quelques lignes du mon codes initiale :
'Do While fs.FileExists(DossierDestination & NomFichier & ".msg") = True
' NomFichier = NomFichierTemp & " - " & i
' i = i + 1
'Loop
Ca a été ma grande interrogation hier.
J'en suis arrivé à la conclusion que le message lui-même pouvait être
enregistré dans ce dossier et pour éviter d'écraser un message par un
autre de même "nom" on ajoutait des caractères derrière.
Vous pourriez le vérifier dans le reste du code.
Un ligne de code s'est en effet malicieusement infiltrée dans votre projet ici à hauteur de la flèche :
NomPj = DossierDestination & "" _ & myAttachments.Item(Pi).DisplayName -----> myAttachments.Item(Pi).SaveAsFile NomPj If fs.FileExists(NomPj) Then
Vous avez tout à fait raison, j'ai omis de la supprimer.
Ensuite, en lisant des pages sur Internet, j'ai supprimé ces quelques lignes du mon codes initiale :
'Do While fs.FileExists(DossierDestination & NomFichier & ".msg") = True ' NomFichier = NomFichierTemp & " - " & i ' i = i + 1 'Loop
Ca a été ma grande interrogation hier. J'en suis arrivé à la conclusion que le message lui-même pouvait être enregistré dans ce dossier et pour éviter d'écraser un message par un autre de même "nom" on ajoutait des caractères derrière. Vous pourriez le vérifier dans le reste du code.
