Import de données d'un classeur fermé

[steph71]

Bonjour à tous,

Grace à la contribution de membres de ce forum, j'ai pu mettre en place une macro qui me permet d'importer dans un fichier des données d'un autre fichier EXCEL fermé.
Cela fonctionne plutôt bien sauf que :

- je n'arrive pas à faire importer également la mise en forme des données

- il ne m'importe pas toutes les entêtes de colonnes.
en effet, toutes les entêtes de colonnes de données numériques ne sont pas remontées.

Je vous soumets mon code
Peut être que aurez la solution pour résoudre mes difficultés

Sub TestQuery()
fich$ = 'C\\\\Fichier_Source.xls'
Feuille$ = 'BASE'
QueryWorksheet fich, Feuille
End Sub

Public Sub QueryWorksheet(NomFichier$, Feuille$)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String

szConnect = 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & NomFichier & ';' & _
'Extended Properties=Excel 8.0;'

szSQL = 'SELECT * FROM [' & Feuille & '$];'

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

If Not rsData.EOF Then
Sheets('BASE').Range('A1').CopyFromRecordset rsData
Else
MsgBox 'Aucun enregistrement renvoyé.', vbCritical
End If

rsData.Close
Set rsData = Nothing

End Sub

 

[MichelXld]

bonjour Steph


pour ce qui est des mises en forme , c'est normal car les requetes ADO ne sont pas prevues pour ça


pour la 2eme partie de ta question :

Par défaut , le pilote ODBC analyse uniquement les 8 premieres lignes du classeur fermé pour déterminer le type de données dans chaque colonne.

2. Si tu veux importer les informations d'une colonne qui contient à la fois des données numériques et texte (l'entete) , c'est le type majoritaire dans les 8 premiere lignes qui définira le type de données à récupérer : les autres données de la colonnes seront considérées comme NULL (vide)
Si la colonne contient 4 valeurs numériques et 4 valeurs texte , la requete renvoie 4 nombres et 4 valeurs NULL.

La solution consiste à activer l'option d'importation 'IMEX=1' ( exemple : 'extended properties=''Excel 8.0;IMEX=1''' ) . Les données numériques seront importées comme du texte


une autre possiblité pour recuperer les entetes

For i = 0 To rs.Fields.Count - 1 'recupere entetes
Range('A1').Offset(0, i) = rs.Fields(i).Name
Next
Range('A2').CopyFromRecordset rs

j'espere que ça pourra t'aider


bonne journée
MichelXld

 

[steph71]

Merci MICHEL pour ces explications qui m'amènent à te poser deux questions :

Comment doit je faire pour activier l'option d'importation IMEX ?

OU dois je mettre ta proposition de code pour importer les entêtes ?

je ne suis pas expert VBA et je galère depuis pas mal de temps pour cette macro d'import.

Merci d'avance

Stéphane

 

[Jam]

Salut Steph, michel,

sauf erreur de ma part tu mets 'IMEX=1' après 'Extended Properties=Excel 8.0;' soit 'Extended Properties=Excel 8.0;IMEX=1'

il faut que tu mettes ce bout de code entre les lignes
If Not rsData.EOF Then
et
Sheets('BASE').Range('A1').CopyFromRecordset rsData
Attention, modifie Range('A1') en 'A2' sinon tu écraseras les noms des champs

Bon courage

PS./ Bien sur tu doit rajouter un p'tit Dim i as Integer pour déclarer i

Message édité par: jam, à: 04/11/2005 10:53

 

[steph71]

Voici mon code modifié en incorporant ton bout de code (en rouge)
si je lance la macro; j'ai une erreur d'exécution de type 424 - Objet requis

Sub TestQuery()
fich$ = 'C:\\Masque_AG_Saisie.xls'
Feuille$ = 'BASE'
QueryWorksheet fich, Feuille
End Sub

Public Sub QueryWorksheet(NomFichier$, Feuille$)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim i As Integer


szConnect = 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & NomFichier & ';' & _
'Extended Properties=Excel 8.0;'

szSQL = 'SELECT * FROM [' & Feuille & '$];'

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

If Not rsData.EOF Then

For i = 0 To rs.Fields.Count - 1 'recupere entetes
Range('A1').Offset(0, i) = rs.Fields(i).Name
Next
Sheets('BASE').Range('A2').CopyFromRecordset rsData Else
MsgBox 'Aucun enregistrement renvoyé.', vbCritical
End If

''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing

End Sub

 

[steph71]

Désolé mais où dois je placer l'instruction 'Extended Properties=Excel 8.0;IMEX=1'

Merci

 

[MichelXld]

bonjourSteph , bonjour Jam

tu peux tester cette synthaxe

Sub TestQuery()
fich$ = 'C:\\\\\\\\Fichier_Source.xls'
Feuille$ = 'BASE'
QueryWorksheet fich, Feuille
End Sub

Public Sub QueryWorksheet(NomFichier$, Feuille$)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim i As Integer

szConnect = 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & NomFichier & ';' & _
'extended properties=''Excel 8.0;IMEX=1'''

szSQL = 'SELECT * FROM [' & Feuille & '$];'

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

If Not rsData.EOF Then
For i = 0 To rsData.Fields.Count - 1 'recupere entetes
Range('A1').Offset(0, i) = rsData.Fields(i).Name
Next
Sheets('BASE').Range('A2').CopyFromRecordset rsData
Else
MsgBox 'Aucun enregistrement renvoyé.', vbCritical
End If

rsData.Close
Set rsData = Nothing
End Sub


remarque :
dans la 1ere version de ta macro , comment faisais tu pour recuperer certains entetes : chez moi cela ne fonctionnait pas


bonne journée
MichelXld

 

[steph71]

Ok, j'ai pu mettre en place le code et cela fonctionne
Merci pour votre aide précieuse
A+