REPERTOIRE ET PDF

Le
pat
Bonsoir,

Je voudrais créer une relation avec ma bd et des documents archivés en PDF.
Dans un formulaire, en sélectionnant un n° d'affaire, je voudrais vérifier
si un répertoire du même nom existe sur mon disque dur. Si oui, afficher son
contenu et pouvoir ainsi ouvir les documents pdf choisis.
Jai commencé avec l'api OPEN FILE trouvé dans les archives mais je coince
Merci d'avance pour votre aide

PAT
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Fabien
Le #6318321
Bonsoir,

Je voudrais créer une relation avec ma bd et des documents archivés en PDF.
Dans un formulaire, en sélectionnant un n° d'affaire, je voudrais vérifier
si un répertoire du même nom existe sur mon disque dur. Si oui, afficher son
contenu et pouvoir ainsi ouvir les documents pdf choisis.
Jai commencé avec l'api OPEN FILE trouvé dans les archives mais je coince...
Merci d'avance pour votre aide

PAT


Salut Pat

Pour ce qui est de parcourir un répértoire a la recherche d'un
répértoire en modifiant cette fonction tu peux t'en tirer

Sub Import_contenu_repertoire(Dossier As String)
Dim rep, Nom_Tbl As String
'obtient le premier fichier ou répertoire qui est dans Dossier
rep = Dir(Dossier & "*.xls", vbDirectory)
'boucle tant que le répertoire n'a pas été entièrement parcouru
On Error GoTo Erreur
Do While (rep <> "")
'teste si c'est un fichier ou un répertoire
If (GetAttr(Dossier & rep) And vbDirectory) = vbDirectory Then
'MsgBox "Répertoire " & rep
Else
Nom_Tbl = Left(rep, Len(rep) - 4)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9,
Nom_Tbl, Dossier & rep, False ', rep & "!"
DoCmd.RunSQL "ALTER TABLE [" & Nom_Tbl & "] ADD COLUMN [Numéro]
COUNTER"
Decoupe Nom_Tbl
End If
Suite:
'passe à l'élément suivant
rep = Dir
Loop
GoTo Fin
Erreur:
DoCmd.RunSQL "INSERT INTO [Erreur import xls] ( [Nom Fichier],
[Code erreur] ) SELECT '" & Dossier & rep & "' AS Fichier, " &
Err.Number & " AS Erreur" ', '" & Err.Description & "' AS MesErr"
Resume Suite
Fin:
End Sub

@+

Publicité
Poster une réponse
Anonyme