ADODB

[siocnarf]

Hi,

I already post here: https://www.pcreview.co.uk/forums/adodb-copyfromrecordset-problem-t4042532.html but I would like explain further.

I am trying to merge different excel fils in a single file using ADODB. Everything seems working correctly until I meet a particular record, see attachment.

The record has 125 lines lenght and 9732 characters lenght. If I am removing some lines then it is starting working... So the problem seems to be the cell is too big.

Is it any workaround?

Sub TestConso()
Dim Fich1$, Fich2$, Source1$, Source2$, Cible$
    Set rsData = Nothing
  Fich1 = "c:\temp\g.xlsx"
  'Fich2 = "c:\temp\a.xlsx"
  Source1 = "Feuil2"
  Source2 = "Feuil2"
  Cible = "Feuil2"
  ConsoDatas Fich1, Source1, Cible
  'ConsoDatas Fich2, Source1, Cible
End Sub
Public Sub ConsoDatas(NomFichier$, FeuilleSource$, FeuilleCible$)
'Va chercher dans le classeur NomFichier (sans l'ouvrir) les données
'de la feuille FeuilleSource et les copie dans la feuille FeuilleCible
'du classeur actif, à la suite des données (éventuellement) déjà présentes.
'(La ligne d'entêtes de FeuilleSource n'est pas importée)
'inspiré de Rob Bovey, mpep
'nécessite une référence à la librairie
'Microsoft ActiveX Data Object 2.x Library
'http://www.excel-downloads.com/forum/35896-activer-la-reference-microsoft-activex-data-object.html
'ThisWorkbook.VBProject.References.AddFromFile ("C:\Program Files\Common Files\System\ado\msado20.tlb ")
'http://blogs.codes-sources.com/coq/archive/2007/09/21/classeurs-excel-via-oledb-et-pour-les-versions-2007-xlsb-xlsm-xlsx.aspx
'http://frederic.sigonneau.free.fr/code/Ado/ADOConsolidation.txt
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim Li&, FeuilleDest
'Version de Excel
'"12"= Excel 2007
'"11"= Excel 2003
StrVersion = Application.Version
    If StrVersion < 12 Then
        'Pre-2007
        ''' Crée la chaîne de connexion
        'Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties="Excel 8.0;HDR=YES;IMEX=1";
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & NomFichier & ";" & _
            "Extended Properties=Excel 8.0;"
    Else
        ' À partir de 2007
        'Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties="Excel 12.0;HDR=YES;IMEX=1";
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & NomFichier & ";" & _
            "Extended Properties=Excel 12.0;"
    End If
    ' La requête est basée sur le nom de la feuille. Ce nom
    ' doit se terminer par un $ et doit être entouré de crochets droits.
    szSQL = "SELECT * FROM [" & FeuilleSource & "$];"
    Set rsData = New ADODB.Recordset
    rsData.Open szSQL, szConnect, adOpenForwardOnly, _
        adLockReadOnly, adCmdText
    
    
    'où envoyer les données :
    Workbooks("consol.xlsx").Activate
    Set FeuilleDest = ActiveWorkbook.Sheets(FeuilleCible)
    'Quelle est la dernière ligne de la feuille?
    Derniereligne = Rows.Count
    Li = FeuilleDest.Range("A" & Derniereligne).End(xlUp).Row + 1
    If Li = 2 Then Li = 1 'Je souhaite que la copie se fasse à partir de la première ligne.
    'envoi sur la première ligne vide
    If Not rsData.EOF Then
      FeuilleDest.Range("A" & Li).CopyFromRecordset rsData
    Else
      'si la source était vide...
      MsgBox "Aucun enregistrement renvoyé.", vbCritical
    End If
    ''' On nettoie pour finir...
    rsData.Close
    Set rsData = Nothing
End Sub

Thanks,


François