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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Fabien
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
@+
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
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
