GetSaveAsFilename : test fichier existant

Fermé
botanucus Messages postés 4 Date d'inscription jeudi 12 octobre 2017 Statut Membre Dernière intervention 15 janvier 2020 - Modifié le 14 janv. 2020 à 21:23
botanucus Messages postés 4 Date d'inscription jeudi 12 octobre 2017 Statut Membre Dernière intervention 15 janvier 2020 - 15 janv. 2020 à 17:18
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 :
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

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 778
14 janv. 2020 à 22:42
Utiliser la commande Dir(chemin)
0
botanucus Messages postés 4 Date d'inscription jeudi 12 octobre 2017 Statut Membre Dernière intervention 15 janvier 2020
15 janv. 2020 à 17:18
Merci Patrice. C'est tout bon ! Pour info, voici ce que j'ai fait :

- 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
0