Connection ADO dans VBA Excel

Gil_ Messages postés 18 Date d'inscription samedi 25 novembre 2006 Statut Membre Dernière intervention 18 janvier 2007 - 15 janv. 2007 à 15:37
Gil_ Messages postés 18 Date d'inscription samedi 25 novembre 2006 Statut Membre Dernière intervention 18 janvier 2007 - 18 janv. 2007 à 19:48
Bonjour à tous,

J'utilise une base de donnée access dans laquelle j'extrait une table AS400 que je copie dans une table ACCESS. Je voudrais faire la même chose dans Excel et c'est la que j'ai un peu de mal ... Je ne sais pas comment lui indiquer de copier les données dans une feuille Excel.

Voici le code que j'utilise actuellement :


Sub Essai()


' variables paramètres

Dim Nas As String 'variable nom de l'As400
Dim Nus As String 'Variable nom utilisateur
Dim Cus As String 'Variable Code Utilisateur


' Les trois variables suivantes vont chercher leurs valeurs dans la table " Paramètres "
Nas = "XXXXX"
Nus = "XXXXX"
Cus = "XXXXX"
bibli = XXXXX
repert = XXXXX
soc = XXXXX


' Nous lançons la connexion.
Set CnnAs400 = CreateObject("ADODB.connection")


Set CnnAs400 = CreateObject("ADODB.connection")
CnnAs400.Open "provider=IBMDA400;data source=" & Nas & "", Nus, Cus


'Set Cnndb = CurrentProject.Connection
Set RsAs400 = CreateObject("ADODB.recordset")
RsAs400.ActiveConnection = CnnAs400




' Nous créons la Requête.


query = " " & _
" select XXXXX " & _
" from " + bibli + "." + repert + "" & _
" where (XXXXX= '" + soc$ + )"


RsAs400.Open query




    Do Until RsAs400.EOF
              i = 1
For Each fld In RsAs400.Fields
    Select Case i
        Case 1
            champ1 = fld.Value
        Case 2
            champ2 = fld.Value
        Case 3
           champ3 = fld.Value
        Case 4
           champ4 = fld.Value
        Case 5
          champ5 = fld.Value
        Case 6
          champ6 = fld.Value
      
Case Else
End Select
i = i + 1
Next fld


If Rsdb.State = 0 Then


' ouverture de la table et remplissage
Rsdb.Open "Table", Cnndb, adOpenKeyset, adlockoptimistic
        End If
With Rsdb
' attribution des valeurs aux champs correspondants


.AddNew Array("XXXXX", "XXXXX", "XXXXX", "XXXX", "XXXX", "XXXX"), _
                 Array(champ1, champ2, champ3, champ4, champ5, champ6)
.Update


End With
RsAs400.MoveNext
Loop


' ferme la connexion
RsAs400.Close
Set RsAs400 = Nothing
Set Rsdb = Nothing
Set CnnAs400 = Nothing
Set Cnndb = Nothing


 


Merci d'avance

3 réponses

Molenn Messages postés 797 Date d'inscription mardi 7 juin 2005 Statut Membre Dernière intervention 23 février 2011 7
15 janv. 2007 à 16:04
Tu veux juste copier une extraction de ta base données dans Excel ? Ne t'embêtes pas dans ce cas à écrire du code.

Dans ta base ACCESS, tu crées juste une requête avec les éléments dont tu as besoin (si tu veux la table complète, sans ajout/modification, tu peux mêm esauter cette étape).

Et dans Excel, tu fais Menu Données\Données externe\Importer les données et tu vas chercher ta base ACCESS. L'assistant te demande quelques options (qui correspondent en fait à ta ligne "CnnAs400.Open "provider=IBMDA400;data source=" & Nas & "", Nus, Cus" en ADO et hop, l'import est effectué.

Si ta table/requête est modifiée, il te suffit d'actualiser les données à partir du Menu Données toujours.

Si tu as besoin du code, utilise l'enregistreur de macro. Tout le boulot sera mâché.

Molenn
0
Gil_ Messages postés 18 Date d'inscription samedi 25 novembre 2006 Statut Membre Dernière intervention 18 janvier 2007
15 janv. 2007 à 16:21
Astucieux ta remarque je ne connaissais pas. Mais en fait je voudrais reproduire le code sous VBA Excel de façon à n'utiliser qu'EXCEL
0
Gil_ Messages postés 18 Date d'inscription samedi 25 novembre 2006 Statut Membre Dernière intervention 18 janvier 2007
18 janv. 2007 à 19:48
Je sais pas s'il existe une solution à mon pb, personne n'a l'air de pouvoir répondre à moins que c'est totalement incompréhensible ...
0
Rejoignez-nous