VBA sous ACCESS 2010
alien59D
-
alien59d -
alien59d -
Bonjour,
Depuis la migration vers Office 2010, j'ai un souci avec [fs=Application.fileSearch] qui n'est plus valide... Voici le corps de ma SUB :
Private Sub GestionImport_Click()
Dim chemin
chemin = DLookup("repertdefaut", "trepertoire")
'*******IMPORTATION ET MISE A JOUR********************
Set fs = Application.FileSearch
With fs
'Selection des fichiers CSV du répertoire
.LookIn = chemin & "\CompteRendu"
.filename = "*.csv"
'Determine le volume de fichiers trouvés dans le répertoire
If .Execute(sortby:=msoSortbyFileName, SortOrder:=msoSortOrderAscending) > 0 Then
'Il y a des fichiers CSV dans le répertoire
MsgBox "Nombre de fichiers trouvés: " & .FoundFiles.count
DoCmd.SetWarnings False
'Boucle de sélection des fichiers trouvés dans le répertoire
comptimport = 0
For i = 1 To .FoundFiles.count
'Choix= Nom du fichier séléctionné
choix = StrConv(.FoundFiles(i), vbLowerCase)
'Vérification si fichier deja importé
contrdouble = DLookup("[NumLigne]", "TSuiviImport", "[Fichier] = '" & choix & "'")
' Fichier jamais importé
If VarType(contrdouble) = 1 Then
'Creation des tables temporaires
DoCmd.CopyObject , "TImport", acTable, "TImportVide"
DoCmd.CopyObject , "TIntermediaire", acTable, "TIntermediaireVide"
'Importation du compte rendu
DoCmd.TransferText acImportDelim, "SpecifImportDMC", "TImport", choix
'Chargement dans le fichier TIntermediaire
DoCmd.OpenQuery "RIntermediaire01"
'Nettoyage des matricules ou numero aberrants (longueur<7) dans le fichier TIntermediaire
DoCmd....
(...)
(...)
Next i
DoCmd.SetWarnings True
MsgBox "Nombre de compte-rendu importés :" & comptimport
Else
'Il n'y a aucun fichiers CSV dans le répertoire
MsgBox "Répertoire vide"
End If
End With
DoCmd.SetWarnings False
>>> avez-vous une solution de rechange, svp, merci
Depuis la migration vers Office 2010, j'ai un souci avec [fs=Application.fileSearch] qui n'est plus valide... Voici le corps de ma SUB :
Private Sub GestionImport_Click()
Dim chemin
chemin = DLookup("repertdefaut", "trepertoire")
'*******IMPORTATION ET MISE A JOUR********************
Set fs = Application.FileSearch
With fs
'Selection des fichiers CSV du répertoire
.LookIn = chemin & "\CompteRendu"
.filename = "*.csv"
'Determine le volume de fichiers trouvés dans le répertoire
If .Execute(sortby:=msoSortbyFileName, SortOrder:=msoSortOrderAscending) > 0 Then
'Il y a des fichiers CSV dans le répertoire
MsgBox "Nombre de fichiers trouvés: " & .FoundFiles.count
DoCmd.SetWarnings False
'Boucle de sélection des fichiers trouvés dans le répertoire
comptimport = 0
For i = 1 To .FoundFiles.count
'Choix= Nom du fichier séléctionné
choix = StrConv(.FoundFiles(i), vbLowerCase)
'Vérification si fichier deja importé
contrdouble = DLookup("[NumLigne]", "TSuiviImport", "[Fichier] = '" & choix & "'")
' Fichier jamais importé
If VarType(contrdouble) = 1 Then
'Creation des tables temporaires
DoCmd.CopyObject , "TImport", acTable, "TImportVide"
DoCmd.CopyObject , "TIntermediaire", acTable, "TIntermediaireVide"
'Importation du compte rendu
DoCmd.TransferText acImportDelim, "SpecifImportDMC", "TImport", choix
'Chargement dans le fichier TIntermediaire
DoCmd.OpenQuery "RIntermediaire01"
'Nettoyage des matricules ou numero aberrants (longueur<7) dans le fichier TIntermediaire
DoCmd....
(...)
(...)
Next i
DoCmd.SetWarnings True
MsgBox "Nombre de compte-rendu importés :" & comptimport
Else
'Il n'y a aucun fichiers CSV dans le répertoire
MsgBox "Répertoire vide"
End If
End With
DoCmd.SetWarnings False
>>> avez-vous une solution de rechange, svp, merci
A voir également:
- VBA sous ACCESS 2010
- Clé activation office 2010 gratuit - Télécharger - Sécurité
- Word 2010 - Télécharger - Traitement de texte
- Waptrick java football 2010 - Télécharger - Jeux vidéo
- Acer quick access - Forum logiciel systeme
- Incompatibilité de type vba ✓ - Forum Programmation
1 réponse
Hello,
Essayes ceci
Cordialement
Essayes ceci
Dim Chemin As String
Dim Fichiers As String
Chemin = DLookup("repertdefaut", "trepertoire") & "\CompteRendu"
Fichiers = Dir(Chemin & "\*.csv", vbDirectory)
Do While (Fichiers <> "")
choix = Fichiers
contrdouble = DLookup("[NumLigne]", "TSuiviImport", "[Fichier] = '" & choix & "'")
If VarType(contrdouble) = 1 Then
...
End If
Fichiers = Dir
Loop
Cordialement
étant en congé je n'ai pu consulter qu'hier et vais tenter de modifier en conséquence dans mon module...
à bientôt !