envoi contenu feuilles vers DB ACCESS qui prennent le nom de la FEUILLE

CAPRI_456

XLDnaute Occasionnel
Bonjour, le Forum,

J'ai un fichier excel ( voir annexe) qui comprend x feuilles qui représentent chacune un pays.
J'ai tenté une procédure dans le module qui doit boucler sur toutes les feuilles (hormis deux)

Celle-ci à pour objet d'envoyer le contenu (colonnes) dans ACCESS, alors que ce fichier est fermé.
Et là cela se corse...

Si la banque INDIA.mdb existe, alors le contenu de la feuille est ajouté à celle-ci,
SI la banque de données d'un pays indiqué comme nom de feuille n'existe pas, la procédure doit la créer puis y ajouter les champs.

Ma procédure est capable d'ajouter les lignes, mais, elle ajoute les lignes de toutes les feuilles à chaque banque de données ACCESS dans le répertoire ad hoc.

Comment aborder cela

Merci pour votre aide

CAPRI_456
 

Fichiers joints

CAPRI_456

XLDnaute Occasionnel
Re : envoi contenu feuilles vers DB ACCESS qui prennent le nom de la FEUILLE

Bonsoir le Forum.

Pour chaque feuille, je dois transférer les datas dans une DB ACCESS qui prend le nom de la feuille
- si cette DB access existe, j'y ajoute les datas de la feuille du même nom
- si cette DB n'existe pas , alors je crée d'abord la DB, puis j'y ajoute les datas.

Voici l'avancée dans mon code:
-le fichier joint reprend le code en question.
J'ai un bug dans le code en rouge
"Vous avez essayé d'affecter la valeur Null à une variable qui n'est pas du type de données Variant"

Sub Transfert_Feuilles_Vers_Access()


'A----- identifie les feuilles à transférer

Dim Ws As Worksheet
For Each Ws In Worksheets 'boucle sur toutes les feuilles du classeur


'B----- identifie le répertoire où se trouvent les bases ACCESS des pays déjà connues

Dim sDB_Path As String
sDB_Path = "D:\ADO-EXCEL-ACCESS\" & Ws.Name & ".mdb"


'
C------ SI LA BASE ACCESS existe déjà =====Y ajouter les datas de la feuille
Dim FSO
Set FSO = CreateObject("Scripting.FilesystemObject")
If (FSO.fileExists(sDB_Path)) Then

'==== C ===============================
Dim Rw As Long
Rw = Ws.Range("A65536").End(xlUp).Row
'teste pour identifier la dernière ligne non vide de la feuille

Dim i, j

Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection

Dim MyConn
MyConn = "D:\ADO-EXCEL-ACCESS\" & Ws.Name & ".mdb"


With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With

Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="TblPopulation", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable

'charge tous les enregistrements de la feuille Excel vers Access.
For i = 2 To Rw
rst.AddNew
For j = 1 To 7
rst(Cells(1, j).Value) = Cells(i, j).Value
Next j
rst.Update
Next i

'
Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing

End If

'D------ SI LA BASE ACCESS N'existe PAS ===== D.1. LA CREER.......
'===== D.2. y COPIER LES DATAS


Else

Dim fld As ADODB.Field


'==== D.1. =============================== CREER LA DATABASE ACCESS
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Set cat = New ADOX.Catalog
cat.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDB_Path & ";"

'==== B =================================CREER LA TABLE avec ses titres

Set tbl = New ADOX.Table
tbl.Name = "TblPopulation"
tbl.Columns.Append "PopID", adVarWChar
tbl.Columns.Append "Country", adVarWChar, 60
tbl.Columns.Append "Yr_1950", adVarWChar
tbl.Columns.Append "Yr_2000", adVarWChar
tbl.Columns.Append "Yr_2015", adVarWChar
tbl.Columns.Append "Yr_2025", adVarWChar
tbl.Columns.Append "Yr_2050", adVarWChar
cat.Tables.Append tbl

Set cat = Nothing

'charge tous les enregistrements de la feuille Excel vers Access.
For i = 2 To Rw
rst.AddNew
For j = 1 To 7
rst(Cells(1, j).Value) = Cells(i, j).Value
Next j
rst.Update
Next i

'
Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing



Next Ws
' poursuit la boucle à la recherche de la feuille suivante

End Sub


Merci pour votre aide pour la poursuite et la résolution de cette erreur .
Bonne soirée et bon début de semaine à tous.

CAPRI_456
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas