Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Access Créer un sous repertoire

netparty

XLDnaute Occasionnel
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.

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

Discussions similaires

Réponses
3
Affichages
180
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…