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
