Erreur d'execution
n
Bonjour j'ai cette erreur d'execution mais je n'arrive pas du tout à trouver pourquoi, quelqu'un peut m'aider ?
Public cnx As New ADODB.Connection
Public rsx As New ADODB.Recordset
'------------------------------------------
Sub creertable()
Dim semaine%, num_colonne%, str$, txt$
Dim ladate As Date
ladate = Date
semaine = Format(ladate, "ww", vbMonday, vbFirstFourDays)
'On Error GoTo lastline:
'Définition du pilote de connexion en fonction de la version office
cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
'Définition de la chaîne de connexion
cnx.ConnectionString = "moncheminb"
'Ouverture de la base de données
cnx.Open
cnx.Execute "DROP TABLE S" & semaine
cnx.Execute "CREATE TABLE [S" & semaine & "](ID integer not null," & _
"Nom_Prénom VARCHAR)" '& _
" FOREIGN KEY(ID) REFERENCES liste_salarie(identifiant_salarie))"
With Sheets("Pointage")
cnx.Execute "ALTER TABLE [S" & semaine & "]" & _
"ADD COLUMN Absences DATETIME," & _
" MIB_XFA DATETIME," & _
" M5K0 DATETIME," & _
" M6 DATETIME," & _
" BER DATETIME," & _
" DELTA DATETIME," & _
" 10T DATETIME," & _
" MEYER1FINITION DATETIME," & _
" PM3 DATETIME," & _
" MEYER2 DATETIME," & _
" AlpiJKT DATETIME," & _
" C10_Tondeuse DATETIME," & _
" C16 DATETIME," & _
" C17 DATETIME," & _
" C21 DATETIME," & _
" TOYOTA DATETIME," & _
" DEC10 DATETIME," & _
" GRAHER DATETIME," & _
" Thermocompression DATETIME," & _
" Qualite DATETIME," & _
" TriQualite_Reclamation_Client DATETIME," & _
" TriQualite_facture_fournisseur DATETIME," & _
" RemplacementSUP DATETIME," & _
" VisiteMedical DATETIME"
cnx.Execute "ALTER TABLE [S" & semaine & "]" & _
" ADD COLUMN Logistique DATETIME," & _
" AiguillePRC6 DATETIME," & _
" Cariste DATETIME," & _
" Formation_ligne DATETIME," & _
" Formation_org_ext DATETIME," & _
" Formation_sprint DATETIME," & _
" Essais DATETIME," & _
" Reunion DATETIME," & _
" Industrialisation DATETIME," & _
" Bondesortie DATETIME," & _
" Délégation DATETIME"
txt = "Select 'Identifiantsalarié','Nomprenom'" & _
"From [Grille polyvalence]" '& _
"Where 'P" & poste & " Between '" & hab & "' And '10'"
rsx.Open txt, cnx
While Not rsx.EOF
For x = 30 To .Range("WZ30").End(xlDown).Row - 1
If .Cells(x, 624).Value = rsx.Fields("Nomprenom") Then
.Cells(x, 623).Value = rsx.Fields("Identifiantsalarié")
Exit For
End If
Next x
rsx.MoveNext
Wend
For x = 30 To Range("WZ30").End(xlDown).Row - 1
str = "INSERT INTO S" & semaine & _
" VALUES(" & .Cells(x, 624) & "','" & .Cells(x, 625) & "','" & .Cells(x, 626) & "','" & _
Cells(x, 627) & "','" & Cells(x, 628) & "','" & Cells(x, 629) & "','" & _
Cells(x, 630) & "','" & Cells(x, 631) & "','" & Cells(x, 632) & "','" & _
Cells(x, 633) & "','" & Cells(x, 634) & "','" & Cells(x, 635) & "','" & _
Cells(x, 636) & "','" & Cells(x, 637) & "','" & Cells(x, 638) & "','" & _
Cells(x, 639) & "','" & Cells(x, 640) & "','" & Cells(x, 641) & "','" & _
Cells(x, 642) & "','" & Cells(x, 643) & "','" & Cells(x, 644) & "','" & _
Cells(x, 645) & "','" & Cells(x, 646) & "','" & Cells(x, 647) & "','" & _
Cells(x, 648) & "','" & Cells(x, 649) & "','" & Cells(x, 650) & "','" & _
Cells(x, 651) & "','" & Cells(x, 652) & "','" & Cells(x, 653) & "','" & _
Cells(x, 654) & "','" & Cells(x, 655) & "','" & Cells(x, 656) & "','" & _
Cells(x, 657) & "','" & Cells(x, 658) & "','" & Cells(x, 659) & "')"
Next
cnx.Execute str, dbFailOnerror
End With
cnx.Execute "DROP TABLE S" & semaine
Set rsx = Nothing
Set cnx = Nothing
Exit Sub
lastline:
cnx.Execute "DROP TABLE S" & semaine
Set rsx = Nothing
Set cnx = Nothing
End Sub
n
Il manque un espace dans :
txt = "Select Identifiantsalarié , Nomprenom " & _
il suffit que je questionne le forum pour trouver moi même la réponse ....