Lire dans classeur fermés .csv

erics83

XLDnaute Impliqué
Bonjour,

J'ai un ensemble de fichiers .csv dans un dossier (300 fichiers). Ils ont tous la même structure. Je cherche à récupérer les 2 premières lignes de chaque fichier. Etant donné que ces fichiers ont été enregistrés en .csv, le nom de la feuille a pris le nom du fichier....
J'ai donc d'abord fait une boucle pour lister les fichiers en faisant (merci JB pour tes très bons tutos...)
Code:
Sub ListeFichiers()
  Application.ScreenUpdating = False
  Range("A2:D65000").ClearContents
  repertoire = ThisWorkbook.Path & "\" ' adapter
  [H2] = repertoire
  ligne = 2
  nf = Dir(repertoire & "*.*") 'premier fichier xls
  Do While nf <> ""
    Cells(ligne, 1) = nf
    Cells(ligne + 1, 1) = nf
  
    ligne = ligne + 2
    nf = Dir ' suivant
  Loop
End Sub
je cherche maintenant à lister en B, le nom des feuilles. cela me permettra ensuite d'adapter le code de Silkyroad, en mettant le "bon" nom de fichier et le "bon" nom de la feuille:
Code:
Sub extractionValeurCelluleClasseurFerme()
    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String
  
    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "B4:B4"
      'Pour une plage de cellules, utilisez:
      'Cellule = "A4:C10"
    
    Feuille = "Feuil1$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = "C:\Base.xls"
              
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
              
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
                
    Set Rst = New ADODB.Recordset
    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
                
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
   
    Range("A2").CopyFromRecordset Rst
          
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

Mais j'ai un problème pour récupérer le nom de la feuille, j'ai essayé le code de JB (au passage, j'ai modifié "x.xls" par "x.csv":
Code:
Sub ListeFeuilles()
  'Microsoft ActiveX DataObject doit être coché
  répertoire = ThisWorkbook.Path & "\" ' adapter
  Fichier = "x.csv"
  Set cnn = CreateObject("ADODB.Connection")
  Set cata = CreateObject("ADOX.Catalog")
  cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & répertoire & Fichier & ";Extended Properties=Excel 8.0;"
  Set cata.ActiveConnection = cnn
  i = 2
  For Each t In cata.Tables
   If Right(t.Name, 1) = "$" Then
     Sheets(1).Cells(i, 1) = Replace(Replace(t.Name, "$", ""), "'", "")
     i = i + 1
   End If
  Next t
  cnn.Close
  Set cata = Nothing
  Set cnn = Nothing
End Sub
Mais le code bloque en disant "MAJ impossible, la base de données ou l'objet est en lecture seule"...alors que tout est fermé.....
Donc, je ne comprends pas....

merci pour votre aide,
 

erics83

XLDnaute Impliqué
Re,

Finalement, puisque lorsqu'on enregistre en .csv, le nom de la feuille prend le nom du fichier, j'ai modifié mon code : en A, je mets le nom du fichier, en B, le nom de la feuille : j'ai mis une formule qui prend le nom du fichier.
Code:
Sub ListeFichiers()
Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String
 
  Application.ScreenUpdating = False
  Range("A2:D65000").ClearContents
  repertoire = ThisWorkbook.Path & "\" ' adapter
  [H2] = repertoire
  ligne = 2
  nf = Dir(repertoire & "*.*") 'premier fichier xls
  Do While nf <> ""
    Cells(ligne, 1) = nf
  
     Cells(ligne, 2).FormulaR1C1 = "=MID(RC[-1],1,FIND("".csv"",RC[-1])-1)"
   
  
    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A1:AA2"
      'Pour une plage de cellules, utilisez:
      'Cellule = "A4:C10"
   
    Feuille = Cells(ligne, 2) & "$" '""" & Cells(ligne, 2) &""$"" 'n'oubliez pas d'ajouter $ au nom de la feuille."
    'Chemin complet du classeur fermé
    Fichier = ThisWorkbook.Path & "\" '"C:\Base.xls"
             
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
             
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
               
    Set Rst = New ADODB.Recordset
    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
               
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
  
    Range("c" & ligne).CopyFromRecordset Rst
         
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
   
    ligne = ligne + 2
    Stop
   
    nf = Dir ' suivant
  Loop
End Sub
Cela devrait normalement fonctionner, mais lorsque je fais tourner le code, il me met en erreur en disant :
"Le moteur de la base de donnée Microsoft jet ne peut pas ouvrir le fichier 'mon chemin'. Il est déjà ouvert en mode exclusif par un autre utilisateur, ou vous devez avoir l'autorisation de visualiser ses données"...comprends pas...

merci pour votre aide,
 

erics83

XLDnaute Impliqué
Merci Pierre,
J'ai un problème avec ton code : je l'ai copié/collé dans un module, mais certaines parties ressortent en rouge (dans le sub et function), j'ai enlevé les tabulations, le texte est re-devenu noir (signalant que le code est OK), mais lorsque veux le lancer, j'ai "Sub ou Function non définie"....

Comprends pas....
merci pour ton aide,
 

erics83

XLDnaute Impliqué
Merci Pierre,
J'ai un problème avec ton code : je l'ai copié/collé dans un module, mais certaines parties ressortent en rouge (dans le sub et function), j'ai enlevé les tabulations, le texte est re-devenu noir (signalant que le code est OK), mais lorsque veux le lancer, j'ai "Sub ou Function non définie"....

Comprends pas....
merci pour ton aide,
 

erics83

XLDnaute Impliqué
Super merci Pierre,

Le code fonctionne parfaitement, et en plus j'en ai compris la logique...

Merci pour ton aide, et une fois de plus, je vois que l'utilisation des Function est vraiment bien.....je bosse dessus en ce moment en faisant différents essais...

Merci,
Eric
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 838
dernier inscrit
Christelle.B86