1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
| Option Compare Database
Option Explicit
'======================================================================================================================================================
' AVANT DE COMMENCER :
' Sur formulaire, liste_fichiers définir Origine Source sur Liste Valeurs pour pouvoir remplir par code
' Dans éditeur VBA, Outils/Références => Microsoft Office 16.0 Object Library pour piloter boîtes dialogues standrads
'======================================================================================================================================================
Private Sub parcourir_Click()
Dim boite_dialogue As Office.FileDialog
Dim nom_dossier As String: Dim fichier As Object 'Pour manipuler les fichiers et dossiers
Dim dossier, chaque_fichier
Set boite_dialogue = Application.FileDialog(msoFileDialogFolderPicker) 'Initialiser sur boîte de dialogue pour désigner dossier
boite_dialogue.Title = "Sélectionner un dossier pour récupérer son contenu"
'signifie que l'utilisateur à sélectionné un dossier et pas cliqué sur Annuler
If boite_dialogue.Show = -1 Then
nom_dossier = boite_dialogue.SelectedItems(1)
chemin.Value = nom_dossier
'objet ActiveX, grâce à la fonction VBA CreateObject pour manipuler les fichiers et dossiers
Set fichier = CreateObject("scripting.filesystemobject")
Set dossier = fichier.getfolder(nom_dossier)
For Each chaque_fichier In dossier.Files
liste_fichiers.AddItem chaque_fichier.Name
Next chaque_fichier
End If
End Sub
Private Sub liste_fichiers_Click()
Dim nom_fichier As String: Dim taille As String: Dim extension As String
Dim date_creation As String: Dim date_modification As String
Dim objet_fichier 'Objet fichier pour désigner le fichier cliqué et récupérer ses propriétés
Dim contenu_fichier As String
Dim taille_lecture As Integer, NLibre As Integer
nom_fichier = chemin.Value & "\" & liste_fichiers.Value
Set objet_fichier = CreateObject("scripting.filesystemobject") 'fonction ActiveX CreateObject, faire référence à un objet Activex, objet externe manipulé par un pilote
extension = objet_fichier.GetExtensionName(nom_fichier)
taille = objet_fichier.GetFile(nom_fichier).Size
date_creation = objet_fichier.GetFile(nom_fichier).DateCreated
date_modification = objet_fichier.GetFile(nom_fichier).DateLastModified
detail.Value = "Créé le : " & date_creation & ", modifié le : " & date_modification & Chr(13) & Chr(10) & "Taille : " & taille & " Octets"
'===============================
'Avant Select case, tester pendant la vidéo
'===============================
Select Case UCase(extension)
Case "JPG", "GIF", "PNG", "JPEG", "BMP"
contenu.Visible = False
img.Visible = True
img.Picture = nom_fichier
Case "TXT", "CSV"
contenu.Visible = True
img.Visible = False
NLibre = FreeFile 'Attribution d'une adresse mémoire libre
Open nom_fichier For Input As NLibre 'Ouverture du fichier à cette adresse
taille_lecture = LOF(NLibre) 'Récupère la taille du Fichier en octets
contenu_fichier = Input(taille_lecture, NLibre) 'Récupère le texte sur la longueur de cette taille, soit tout le contenu
Close NLibre
contenu.Value = contenu_fichier
Case Else
contenu.Visible = True
img.Visible = False
contenu.Value = "Contenu non disponible !" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Cliquez sur le bouton Ouvrir pour l'exécuter dans son application"
End Select
End Sub
Private Sub ouvrir_Click()
Dim nom_fichier As String: Dim MonApplication As Object 'Pour ouvrir un fichier dans son application
nom_fichier = chemin.Value & "\" & liste_fichiers.Value
Set MonApplication = CreateObject("Shell.Application") 'fonction ActiveX CreateObject, faire référence à un objet Activex, objet externe manipulé par un pilote
MonApplication.Open (nom_fichier)
End Sub
Private Sub fermer_Click()
DoCmd.Close acForm, "acces_fichiers"
End Sub |
Finaliser ma programmation VBA Access au travers de mes codes VBA déjà crées
Répondre avec citation
Envoyé par marot_r
Partager