Access Créer un sous repertoire

[netparty]

Bonjour à tous

Je cherche a améliorer mon code, le code que j'ai ci-dessous fonction il me sert a aller chercher un fichier m'inporte ou puis le recopier dans le repertoire ou se trouve ma db.

J'aimerais quand j'importe le fichier qu'access crée un sous-dossier avec le nom qui se trouve dans la textbox "marque" , si le répertoire n'existe pas alors il le crée sinon il copie juste le fichier dans le bon répertoire.

Private Sub btnInserer_Click()

'Déclaration des variables
Dim strFichier As String
Dim oFD As FileDialog

'Paramètre la fenêtre Ouvrir
Set oFD = Application.FileDialog(msoFileDialogOpen)
With oFD
    'Ajoute les filtres pour fichiers images et tous
    With .Filters
        .Clear
        .Add "Fichiers PDF", "*.pdf", 1
        .Add "Tous", "*.*", 2
    End With
    'Renseignement du titre
    .Title = "Insérer un fichier PDF"
    'Ouvre l'explorateur dans le fichier 'Mes documents' du User connecté.
    .InitialFileName = Environ("USERPROFILE") & "\Desktop"
    'Interdit la multi sélection
    .AllowMultiSelect = False
    'Permet de choisir le mode d'affichage dans l'explorateur (ici apperçu)
    .InitialView = msoFileDialogViewThumbnail
    'Permet de personnaliser le bouton.
    .ButtonName = "Insérer"
    
    'Affiche la fenêtre
    If .Show Then
        On Error GoTo fini  'gestion erreur pour control importation

        'Retourne un erreur si pas fichier image.
       ' Me.Image1.Picture = .SelectedItems(1)
        'Vide du cadre image.
        'Me.Fichier.Picture = ""
        'Extraction du nom du fichier à copier.
        strFichier = Mid(.SelectedItems(1), InStrRev(.SelectedItems(1), "\"))
        'Copie du fichier sélectionné vers le sous dossier de la base.
        FileCopy .SelectedItems(1), CurrentProject.Path & "\Data_DB" & strFichier
        'Chargement dans control du chemin de l'image (sous dossier base).
        Me.Fichier = CurrentProject.Path & "\Data_DB" & strFichier
        'Rafraîchit le Formulaire.
        Me.Refresh

    End If
End With
Exit Sub
end sub

Merci d'avance pour votre aide

Bonne journée à tous

 

[kiki29]

Salut, voir ici ?

 

[netparty]

Salut, voir ici ?

Merci