importation de données avec ADO bizarrerie

[michael]

Bonjour,

je relance un nouveau fil alors que j'ai deja posé la question hier soir mais je pense apres reflexion ' et re-lecture de charte ' qu'il faut mieux ne pas melanger les questions dans le meme fil

donc

dans la masse de fichiers a traiter variable de 1 à 200,ma macro zappe quelques fichiers et dans d'autres elle ne voit pas les valeurs comme si elles etaient transparente

ci joint un bout du code, je pense que le probleme est là

If Tableau(X) <> ThisWorkbook.Name Then
    
        Fichier = ActiveWorkbook.Path & '\\' & Tableau(X)
        N = 0
    
    connect = 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
                        'data source=' & Fichier & ';' & _
                        'extended properties=Excel 8.0;'
                        
    'ici la zone a copier dans la feuille 
    Sql = 'SELECT * FROM [' & onglet & '$t9:t55]'
   
    Set données = New ADODB.Recordset
    données.Open Sql, connect, adOpenForwardOnly, _
                adLockReadOnly, adCmdText
    
  
    Do While Not données.EOF
    ' pour etre synchro avec les colonnes
    p = X - 1
        Cells(3, 2 + p) = Tableau(X)
        Cells(N + 4, 2 + p).CopyFromRecordset données
    N = N + 1
    Loop
            
    End If

avez deja rencontré ce genre de probleme et comme avez vous resolu le probleme

bonne journée a tous je pars au taf a ce soir

@+

 

[michel_m]

Bonjour Michael et le forum,

Difficille de te répondre sans voir l'appli.

une piste peut-être pour la 'transparence' des données

Si T9:T55 ne contient que des données, cad pas d'étiquette de champ dans la cellule, il faut le préciser sous cette forme

'Extended Properties=''Excel 8.0;HDR=No;'';'

HDR étant l'acronyme de HEADER soit étiquette

quant aux fichiers zappés, peut être vérifier en amont le contenu et le REDIM PRESERVE de tableau()

il y a aussi et toujours peut-être cette boucle qui me parait inutile:

Do While Not données.EOF
' pour etre synchro avec les colonnes
p = X - 1
Cells(3, 2 + p) = Tableau(X)
Cells(N + 4, 2 + p).CopyFromRecordset données
N = N + 1
Loop

que tu pourrais remplacer par

p = X - 1
Cells(3, 2 + p) = Tableau(X)
Cells(N + 4, 2 + p).CopyFromRecordset données

reste à voir en fonction de la variable 'N'

Voilà mais ce ne sont que des pistes

Bon courage

Michel_M

 

[michael]

bonjour michel m et le forum

bon ca n'a rien changé le hdr=0

je joins le code pour eclaircir cette bizarrerie

Sub CommandButton1_Click()
'sources XLD,WROX

    Dim connect As String
    Dim Sql As String, onglet As String
    Dim data As ADODB.Recordset
    Dim Fichier As String, Direction As String, texte_SQL As String
    Dim X As Integer, NbFichiers As Integer, N As Integer, p As Integer, w As Integer
    
    Dim Tableau() As String

    onglet = InputBox('Saisissez le nom d'un onglet :')
    If onglet = '' Then Exit Sub
    Direction = Dir(ThisWorkbook.Path & '\\*.xls')
    Do While Len(Direction) > 0 'liste tous les classeurs du repertoire
    NbFichiers = NbFichiers + 1
    ReDim Preserve Tableau(1 To NbFichiers)
    Tableau(NbFichiers) = Direction
    Direction = Dir()
    Loop
    
    If NbFichiers > 0 Then
    For X = 1 To NbFichiers 'boucles sur les classeurs

    ' pour ne pas prendre en compte le classeur contenant la macro (synthese)
    If Tableau(X) <> ThisWorkbook.Name Then
    
        Fichier = ActiveWorkbook.Path & '\\' & Tableau(X)
        N = 0
    
    connect = 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
                        'data source=' & Fichier & ';' & _
                        'extended properties=''Excel 8.0;HDR=no;'';'
                        
    'ici la zone a copier dans la feuille dim
    Sql = 'SELECT * FROM [' & onglet & '$t9:t55]'
   
    Set data = New ADODB.Recordset
    data.Open Sql, connect, adOpenForwardOnly, _
                adLockReadOnly, adCmdText
    
  
    Do While Not data.EOF
    ' pour etre synchro avec les colonnes
    p = X - 1
        Cells(3, 2 + p) = Tableau(X)
        Cells(N + 4, 2 + p).CopyFromRecordset data
    N = N + 1
    Loop
            
    End If
Next X
End If

Application.ScreenUpdating = True
    
'delete de l'objet recordset
data.Close
Set data = Nothing

specification

'supprimer lignes vides à partir de ligne3

'For w = Range('b65536').End(xlUp).Row To 3 Step -1
'        If Cells(w, 1) = '' Then
'           Rows(w).Delete
'        End If
'Next w

End Sub

voila et merci pour le coup de main

@+