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

Réponse 1 / 2

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
14 janv. 2020 à 22:42

Utiliser la commande Dir(chemin)

Réponse 2 / 2

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

Discussions similaires

VBA - GetSaveAsFilename

Discussions similaires

Newsletters