GetSaveAsFilename : test fichier existant
botanucus
Messages postés
4
Statut
Membre
-
botanucus Messages postés 4 Statut Membre -
botanucus Messages postés 4 Statut Membre -
Bonjour,
Pour info : Windows 7 - Excel 2003
Je découvre les fonctions GetOpenFilename et GetSaveAsFilename que j'ai réussi à comprendre et à exploiter dans une appli. perso.
Fonctionnement OK de GetSaveAsFilename, sauf si je donne comme nom de fichier un fichier existant : le nouveau fichier remplace l'ancien, sans message du genre "Le fichier xxxxx existe déjà, voulez-vous le remplacer ?
Comment m'y prendre pour tester l’existence d'un même nom de fichier ?
Merci d'avance.
Voici mon code :
Pour info : Windows 7 - Excel 2003
Je découvre les fonctions GetOpenFilename et GetSaveAsFilename que j'ai réussi à comprendre et à exploiter dans une appli. perso.
Fonctionnement OK de GetSaveAsFilename, sauf si je donne comme nom de fichier un fichier existant : le nouveau fichier remplace l'ancien, sans message du genre "Le fichier xxxxx existe déjà, voulez-vous le remplacer ?
Comment m'y prendre pour tester l’existence d'un même nom de fichier ?
Merci d'avance.
Voici mon code :
Public Sub SauverSequence()
' Enregistre la séquence en cours dans un fichier
Dim i As Integer, strTitre, strNote As String
Range("A4").Activate
strTitre = ActiveCell.Value
fichierSequence = Application.GetSaveAsFilename(InitialFileName:=strTitre, fileFilter:="Séquence (*.seq), *.seq")
If fichierSequence <> False Then
Open fichierSequence For Output As #1
Print #1, strTitre
Range("B6").Activate
While strNote <> "-1"
strNote = ActiveCell.Offset(i, 0)
Print #1, strNote
i = i + 1
Wend
Close #1
End If
End Sub
Configuration: Windows / Chrome 79.0.3945.117
2 réponses
Merci Patrice. C'est tout bon ! Pour info, voici ce que j'ai fait :
- Dans mon Sub :
- Ma fonction :
- Dans mon Sub :
If Not Fichier_Existe((FichierSequence)) Then
If MsgBox("Ce fichier existe déjà. Voulez-vous le remplacer ?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
- Ma fonction :
Function Fichier_Existe(F As String) As Boolean
Dim D As String
If F <> "" Then
F = Mid(F, InStrRev(F, "\") + 1)
D = Dir("*.seq")
Do While D <> ""
If D = F Then
Exit Do
Else
D = Dir()
End If
Loop
End If
Fichier_Existe = (D <> F)
End Function
