Accès aux fichiers en VBA Access

**morobaboumar** · 23/11/2018, 22h51

Salut membres du forum !
J'aimerais savoir pourquoi les messages d'erreur suivante surviennent
alors que j'ai suivi à la lettre les explications de comment et où placer
les différents codes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub fermer_Click()
DoCmd.Close acForm, "acces_fichiers"
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
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")
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'"
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
 
Open nom_fichier For Input As NLibre
taille_lecture = LOF(NLibre)
contenu_fichier = Input(taille_lecture, NLibre)
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
 
nom_fichier = chemin.Value & " & liste_fichiers.Value"
Set MonApplication = CreateObject("'Shell.Application'")
MonApplication.Open (nom_fichier)
End Sub
 
Private Sub parcourir_Click()
Dim boite_dialogue As Office.FileDialog
Dim nom_dossier As String: Dim fichier As Object
Dim dossier, chaque_fichier
Set boite_dialogue = Application.FileDialog(msoFileDialogFolderPicker)
boite_dialogue.Title = "Sélec..onner un dossier pour récupérer son contenu"
If boite_dialogue.Show = -1 Then
nom_dossier = boite_dialogue.SelectedItems(1)
chemin.Value = nom_dossier
Set fichier = CreateObject("scripting.filesystemobject")
Set dossier = fichier.GetFolder(nom_dossier)
End If
For Each chaque_fichier In dossier.Files
liste_fichiers.AddItem chaque_fichier.Name
Next chaque_fichier
End Sub

Nom : CaptureBD_AccesAuxFichiers.PNG
Affichages : 512
Taille : 22,2 Ko

Nom : CaptureBD_AccesAuxFichiers2.PNG
Affichages : 633
Taille : 66,0 Ko

Cordialement.

**tee_grandbois** · 23/11/2018, 23h30

bonsoir,

J'aimerais savoir pourquoi les messages d'erreur suivante surviennent
alors que j'ai suivi à la lettre les explications de comment et où placer
les différents codes:

probablement à cause d'une étourderie :
ton code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nom_fichier = chemin.Value & " & liste_fichiers.Value"

code corrigé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nom_fichier = chemin.Value & "\" & liste_fichiers.Value

**morobaboumar** · 24/11/2018, 00h11

Salut tee_grandbois!
Après correction, voici encore la capture d'erreur après Click sur la cmd ouvrir:
Nom : CaptureComposantActiveX.PNG
Affichages : 464
Taille : 35,3 Ko

Nom : CaptureComposantActiveX.PNG
Affichages : 464
Taille : 35,3 Ko

Nom : CaptureBD_AccesAuxFichiers2.PNG
Affichages : 470
Taille : 66,0 Ko

Cordialement!

**tee_grandbois** · 24/11/2018, 13h20

bonjour,

Après correction, voici encore la capture d'erreur après Click sur la cmd ouvrir:

et pourtant, sur la capture écran, on voit que le code n'est pas corrigé ...

**morobaboumar** · 24/11/2018, 20h03

Salut membres du forum !
Effectivement j'ai corrigé la ligne de code comme vous me l'avez signalé.
Ensuite remplacé l'accent (') par les griffes (").
Tout marche.
Voici le corrigé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub fermer_Click()
DoCmd.Close acForm, "acces_fichiers"
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
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")
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"
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
 
Open nom_fichier For Input As NLibre
taille_lecture = LOF(NLibre)
contenu_fichier = Input(taille_lecture, NLibre)
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
 
nom_fichier = chemin.Value & "\" & liste_fichiers.Value
Set MonApplication = CreateObject("Shell.Application")
MonApplication.Open (nom_fichier)
End Sub
 
Private Sub parcourir_Click()
Dim boite_dialogue As Office.FileDialog
Dim nom_dossier As String: Dim fichier As Object
Dim dossier, chaque_fichier
Set boite_dialogue = Application.FileDialog(msoFileDialogFolderPicker)
boite_dialogue.Title = "Sélec..onner un dossier pour récupérer son contenu"
If boite_dialogue.Show = -1 Then
nom_dossier = boite_dialogue.SelectedItems(1)
chemin.Value = nom_dossier
Set fichier = CreateObject("scripting.filesystemobject")
Set dossier = fichier.GetFolder(nom_dossier)
End If
For Each chaque_fichier In dossier.Files
liste_fichiers.AddItem chaque_fichier.Name
Next chaque_fichier
End Sub

Question: peut ON ajouter d'autres extensions ici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
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

?
Cordialement.

**tee_grandbois** · 24/11/2018, 23h37

il faut essayer ...

c'est le meilleur moyen d'avancer.
Bonne continuation

Accès aux fichiers en VBA Access [AC-2013]

Access

Discussions similaires

Partager

Partager