Besoin d'aide pour conversion Access 2003 2007

Besoin d'aide pour conversion Access 2003 2007 - VB/VBA/VBS - Programmation

Marsh Posté le 04-10-2010 à 13:05:53    

Bonjour a tous,
 
Je viens a vous desepérement car ca fait plus d'une semaine que j'essay de convertir ce code en 2007 car ma fonction "Application.FileSearch" ne fonctionne plus sous 2007...
Il y a bien une solution sous excell pour rajouter cette fonction mais ca ne marche pas sous access.
 
Voici mon code :
 

Code :
  1. Sub import()
  3.        Set fs = Application.FileSearch   ' NE FONCTIONNE PLUS
  4.    
  5.     With fs
  6.    
  7.         .LookIn = "C:\mon dossier"
  8.         .filename = "*.TXT"                                 ' JE RECUPERE MON FICHIER TEXT TOUTE LES 15 MIN IMPORT D'UN FTP
  9.        
  10.         If .Execute(SortBy:=msoSortbyFileName, _
  11.             SortOrder:=msoSortOrderAscending) > 0 Then
  12.                  
  13.                 For i = 1 To .Foundfiles.Count
  14.                 FileCopy .Foundfiles(i), "C:\mon dossier save" & Right(.Foundfiles(i), (Len(.Foundfiles(i)) - InStrRev(.Foundfiles(i), "\" )))     ' SAVE DES FICHIERS
  15.                 DoCmd.TransferText acImportDelim, "Spécification export ORDER", "FICHIER ORDER", .Foundfiles(i), False, ""                     ' IMPORT DANS MA TABLE SUIVANT UN SP2CIFICATION D'IMPORTATION
  16.                 Kill (.Foundfiles(i))
  17.              
  18.          Next i
  19.              Else
  20.                  End If
  21. End With
  22. End Sub


 
MERCI DE VOTRE AIDE CAR LA JE c'est plus quoi faire !!!!!  :??:  
 
j'ai bien essayé avec un dir mais j'arrive pas a l'importater dans ma table existante " FICHIER ORDER"
 
MERCI MERCI D'avance


Message édité par fabiencer84 le 04-10-2010 à 13:44:22
Reply

Marsh Posté le 04-10-2010 à 13:05:53   

Reply

Marsh Posté le 04-10-2010 à 13:30:03    

Salut, va jeter un oeil sur http://www.developpez.net/forums/d [...] oundfiles/ sinon via Gog http://www.google.fr/search?hl=fr& [...] =&gs_rfai=


Message édité par kiki29 le 04-10-2010 à 13:33:18
Reply

Marsh Posté le 04-10-2010 à 13:30:43    

TItre modifié : les titres tout en majuscules sont prohibés. Merci de lire les règles de la section.

Reply

Marsh Posté le 04-10-2010 à 13:41:00    

Oui justement j'ai vu ce topics mais c'est ultra compliqué et je n'arrive pas a le mettre en action.
 
j'espere trouver un code plus simple comme celui que j'avais sous 2003.
 
Je suis debutant et je ne connais presque pas le vba.

Reply

Marsh Posté le 04-10-2010 à 13:59:51    

Re, en allant au plus simple ( pas de récursion ) : c'est du VBA mais testé sous Excel


Option Explicit
 
Dim Tableau() As String
 
Sub Tst()
Dim i As Long
    Erase Tableau
    ListeFichiersDansDossier ThisWorkbook.Path, "txt", 0
    For i = LBound(Tableau) To UBound(Tableau)
        Debug.Print i, Tableau(i)
    Next i
End Sub
 
Private Sub ListeFichiersDansDossier(sChemin As String, sExt As String, r As Long)
Dim Fichier As String, sPath As String
 
    Fichier = Dir$(sChemin & "\*." & sExt)
    Do While Len(Fichier) > 0
        ReDim Preserve Tableau(r)
        sPath = sChemin & "\" & Fichier
        Tableau(r) = sPath
        r = r + 1
        Fichier = Dir$()
    Loop
End Sub


en adaptant (sans doute) et insérant  


            For i = 1 To .FoundFiles.Count
                FileCopy .FoundFiles(i), "C:\mon dossier save" & Right(.FoundFiles(i), (Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\" )))      ' SAVE DES FICHIERS
                DoCmd.TransferText acImportDelim, "Spécification export ORDER", "FICHIER ORDER", .FoundFiles(i), False, ""                     ' IMPORT DANS MA TABLE SUIVANT UN SP2CIFICATION D'IMPORTATION
                Kill (.FoundFiles(i))
            Next i


à la place du


 Debug.Print i, Tableau(i)


Ce qui sauf erreur de ma part devrait donner


Option Explicit  
 
Dim Tableau() As String  
 
Sub Tst2()
Dim i As Long
    Erase Tableau
    ListeFichiersDansDossier "C:\mon dossier", "txt", 0
    For i = LBound(Tableau) To UBound(Tableau)
        FileCopy Tableau(i), "C:\mon dossier save" & Right$(Tableau(i), (Len(Tableau(i)) - InStrRev(Tableau(i), "\" )))
        DoCmd.TransferText acImportDelim, "Spécification export ORDER", "FICHIER ORDER", Tableau(i), False, ""
        Kill (Tableau(i))
    Next i
End Sub
 
Private Sub ListeFichiersDansDossier(sChemin As String, sExt As String, r As Long)  
Dim Fichier As String, sPath As String  
 
    Fichier = Dir$(sChemin & "\*." & sExt)  
    Do While Len(Fichier) > 0  
        ReDim Preserve Tableau(r)  
        sPath = sChemin & "\" & Fichier  
        Tableau(r) = sPath  
        r = r + 1  
        Fichier = Dir$()  
    Loop  
End Sub


Message édité par kiki29 le 04-10-2010 à 15:24:06
Reply

Marsh Posté le 04-10-2010 à 16:42:42    

J'ai une erreur sur la ligne "For i = LBound(Tableau) To UBound(Tableau)"  code exe 9 "l'indice n'appartient pas a la selection"
 
Mais deja merci j'y vois deja beaucoup plus clair
 
EDIT 2 C'EST BON CA MARCHE MERRRRRRRRRRRRRRRRRRRRRRRRRCI    :bounce:  :bounce:  
 
en fait ca marche plus quand le dossier est vide.
 
Donc encore une petit demande comment puije interdire l'import si mon dossier est vide? car si mon dossier est vide j'ai lerreur ci dessus.
Ou du moins avoir un message "dossier vide " a la place d'erreur 9?
 
MERCI


Message édité par fabiencer84 le 04-10-2010 à 17:28:43
Reply

Marsh Posté le 04-10-2010 à 18:24:38    

Re, qqch comme cela devrait convenir


Option Explicit
   
Dim Tableau() As String
Dim bFlag As Boolean
 
Sub Tst2()
Dim i As Long
    Erase Tableau
    bFlag = False  
    ListeFichiersDansDossier "C:\mon dossier", "txt", 0
    If bFlag = True Then  
        MsgBox "Pas de Fichier", vbOKOnly + vbInformation, "Info"  
        Exit Sub  
    End If  
    For i = LBound(Tableau) To UBound(Tableau)
        FileCopy Tableau(i), "C:\mon dossier save" & Right$(Tableau(i), (Len(Tableau(i)) - InStrRev(Tableau(i), "\" )))
        DoCmd.TransferText acImportDelim, "Spécification export ORDER", "FICHIER ORDER", Tableau(i), False, ""
        Kill (Tableau(i))
    Next i
End Sub
 
Private Sub ListeFichiersDansDossier(sChemin As String, sExt As String, r As Long)
Dim Fichier As String, sPath As String
   
    Fichier = Dir$(sChemin & "\*." & sExt)
    If Len(Fichier) = 0 Then
        bFlag = True
        Exit Sub
    End If
    Do While Len(Fichier) > 0
        ReDim Preserve Tableau(r)
        sPath = sChemin & "\" & Fichier
        Tableau(r) = sPath
        r = r + 1
        Fichier = Dir$()
    Loop
End Sub


Message édité par kiki29 le 10-10-2010 à 17:40:50
Reply

Marsh Posté le 04-10-2010 à 18:59:19    

kiki29 tu est trop fort....
Il y avait un beug dans ton code mais grace a toi j'ai su le rectifié et maintenant tout fonctionne.
 
voici mon code definitif :  

Code :
  1. Option Explicit
  2.  
  3. Dim Tableau() As String
  4. Dim bFlag As Boolean
  6. Private Sub ListeFichiersDansDossier(sChemin As String, sExt As String, r As Long)
  7. Dim Fichier As String, sPath As String
  8.  
  9.     Fichier = Dir$(sChemin & "\*." & sExt)
  10.     If Len(Fichier) = 0 Then bFlag = True
  11.     Do While Len(Fichier) > 0
  12.         ReDim Preserve Tableau(r)
  13.         sPath = sChemin & "\" & Fichier
  14.         Tableau(r) = sPath
  15.         r = r + 1
  16.         Fichier = Dir$()
  17.     Loop
  18. End Sub
  20. Sub import_kyocera2()
  21. Dim i As Long
  22.     Erase Tableau
  23. bFlag = False
  24.         ListeFichiersDansDossier "C:\", "txt", 0
  25.           If bFlag = True Then
  26.         MsgBox "Pas de Fichier", vbOKOnly + vbInformation, "Info"
  27.         Exit Sub
  28.         Else
  29.       For i = LBound(Tableau) To UBound(Tableau)
  30.         FileCopy Tableau(i), "C:\SAUVEGARDE\" & Right$(Tableau(i), (Len(Tableau(i)) - InStrRev(Tableau(i), "\" )))
  31.         DoCmd.TransferText acImportDelim, "Spécification export ORDER", "FICHIER ORDER", Tableau(i), False, ""
  32.         Kill (Tableau(i))
  33.    Next i
  34.     End If
  35. End Sub


 
Encore merci a toi


Message édité par fabiencer84 le 04-10-2010 à 19:01:16
Reply

Marsh Posté le 04-10-2010 à 19:11:11    

Re, à priori  


Sub import_kyocera2()
Dim i As Long
    Erase Tableau
    bFlag = False
    ListeFichiersDansDossier "C:\", "txt", 0
    If bFlag = True Then
        MsgBox "Pas de Fichier", vbOKOnly + vbInformation, "Info"
        Exit Sub
    End If
 
    For i = LBound(Tableau) To UBound(Tableau)
        FileCopy Tableau(i), "C:\SAUVEGARDE\" & Right$(Tableau(i), (Len(Tableau(i)) - InStrRev(Tableau(i), "\" )))
        DoCmd.TransferText acImportDelim, "Spécification export ORDER", "FICHIER ORDER", Tableau(i), False, ""
        Kill Tableau(i)
    Next i
End Sub


Message édité par kiki29 le 05-10-2010 à 06:42:47
Reply

Marsh Posté le 05-10-2010 à 13:48:09    

Yes ca fonctionne aussi plus judicieux...
Merci en tout cas

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed