GetSaveAsFilename : test fichier existant

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

  1. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Utiliser la commande Dir(chemin)
    0
  2. botanucus Messages postés 4 Statut Membre
     
    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