OVH Cloud OVH Cloud

erreur urgent

1 réponse
Avatar
Franck
Bonjour,
Mon probleme: ma sub me genere une erreur pourtant je ne vois pas qui
cloche.
L'erreur est la suivante:
Erreur numero:-2147217904
Description:Aucune valeur donnee pour un ou plusieurs parametres requis

Voici ma sub: (le contexte: j'essaie d'exporter des donnees depuis excel
vers acces en utilisant sql)

Sub CreateTableAndAddData()
Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command

Dim viCols%
Dim viRows%
Dim viCount%
Dim viRcount%
Dim vtWrapChar$
Dim vtSql$
Dim vtMessage$

'On Error GoTo ErrorHandler

ThisWorkbook.Activate

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Creation connexion
cnn.Open DbConnection

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' cellule gauche de la plage
Application.GoTo reference:=Range("rtlData")

''on recupere nb colonnes/lignes
With ActiveCell.CurrentRegion
viCols = .Columns.Count
viRows = .Rows.Count
End With

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
On Error Resume Next
vtSql = ""
vtSql = vtSql & " DROP TABLE " & ctSheet

cmd.CommandText = vtSql
cmd.ActiveConnection = cnn
cmd.Execute

On Error GoTo ErrorHandler

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Creation de la table

ActiveCell.CurrentRegion.Cells(1, 1).Select

vtSql = ""
vtSql = vtSql & " CREATE TABLE " & ctSheet & " ("

'' boucle ds chaque colonne pr creer code sql
With ActiveCell.CurrentRegion
For viCount = 1 To viCols
vtSql = vtSql & .Cells(1, viCount) & "x " &
fGetCellFormat(.Cells(2, viCount))
If viCount <> viCols Then
vtSql = vtSql & ", "
Else
vtSql = vtSql & ")"
End If
Next
End With

''exceution ds la bdd
cmd.CommandText = vtSql

cmd.ActiveConnection = cnn

cmd.Execute

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Insertion des donnees dans la the table
With ActiveCell.CurrentRegion
For viRcount = 2 To viRows

vtSql = ""
vtSql = vtSql & " INSERT INTO " & ctSheet
vtSql = vtSql & " VALUES ("

For viCount = 1 To viCols
Select Case fGetCellFormat(.Cells(2, viCount))
Case "TEXT"
vtWrapChar = """"
Case "DATETIME"
vtWrapChar = "#"
Case Else
vtWrapChar = ""
End Select

vtSql = vtSql & vtWrapChar & .Cells(viRcount, viCount) &
vtWrapChar

If viCount <> viCols Then
vtSql = vtSql & ","
Else
vtSql = vtSql & ")"
End If
Next

cmd.CommandText = vtSql

cmd.Execute
Next
End With

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' fermeture
lbTidy:
'' Close the connection
'' cnn.Close
Set cnn = Nothing
Set cmd = Nothing

Exit Sub

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ErrorHandler:

vtMessage = "Erreur lors de la creation"
vtMessage = vtMessage & _
Chr(10) & _
Chr(10) & "Erreur Numéro: " & Err & _
Chr(10) & "Description: " & Error()

MsgBox vtMessage, vbInformation, ctByg

Resume lbTidy

End Sub



Cordialement
Francky

1 réponse

Avatar
Pierre CFI [mvp]
bonjour
il doit manquer du code, tu ouvres une connection sur quoi ?

--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site perso
http://access.cfi.free.fr
"Franck" a écrit dans le message de news:%
Bonjour,
Mon probleme: ma sub me genere une erreur pourtant je ne vois pas qui
cloche.
L'erreur est la suivante:
Erreur numero:-2147217904
Description:Aucune valeur donnee pour un ou plusieurs parametres requis

Voici ma sub: (le contexte: j'essaie d'exporter des donnees depuis excel
vers acces en utilisant sql)

Sub CreateTableAndAddData()
Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command

Dim viCols%
Dim viRows%
Dim viCount%
Dim viRcount%
Dim vtWrapChar$
Dim vtSql$
Dim vtMessage$

'On Error GoTo ErrorHandler

ThisWorkbook.Activate

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Creation connexion
cnn.Open DbConnection

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' cellule gauche de la plage
Application.GoTo reference:=Range("rtlData")

''on recupere nb colonnes/lignes
With ActiveCell.CurrentRegion
viCols = .Columns.Count
viRows = .Rows.Count
End With

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
On Error Resume Next
vtSql = ""
vtSql = vtSql & " DROP TABLE " & ctSheet

cmd.CommandText = vtSql
cmd.ActiveConnection = cnn
cmd.Execute

On Error GoTo ErrorHandler

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Creation de la table

ActiveCell.CurrentRegion.Cells(1, 1).Select

vtSql = ""
vtSql = vtSql & " CREATE TABLE " & ctSheet & " ("

'' boucle ds chaque colonne pr creer code sql
With ActiveCell.CurrentRegion
For viCount = 1 To viCols
vtSql = vtSql & .Cells(1, viCount) & "x " &
fGetCellFormat(.Cells(2, viCount))
If viCount <> viCols Then
vtSql = vtSql & ", "
Else
vtSql = vtSql & ")"
End If
Next
End With

''exceution ds la bdd
cmd.CommandText = vtSql

cmd.ActiveConnection = cnn

cmd.Execute

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Insertion des donnees dans la the table
With ActiveCell.CurrentRegion
For viRcount = 2 To viRows

vtSql = ""
vtSql = vtSql & " INSERT INTO " & ctSheet
vtSql = vtSql & " VALUES ("

For viCount = 1 To viCols
Select Case fGetCellFormat(.Cells(2, viCount))
Case "TEXT"
vtWrapChar = """"
Case "DATETIME"
vtWrapChar = "#"
Case Else
vtWrapChar = ""
End Select

vtSql = vtSql & vtWrapChar & .Cells(viRcount, viCount) &
vtWrapChar

If viCount <> viCols Then
vtSql = vtSql & ","
Else
vtSql = vtSql & ")"
End If
Next

cmd.CommandText = vtSql

cmd.Execute
Next
End With

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' fermeture
lbTidy:
'' Close the connection
'' cnn.Close
Set cnn = Nothing
Set cmd = Nothing

Exit Sub

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ErrorHandler:

vtMessage = "Erreur lors de la creation"
vtMessage = vtMessage & _
Chr(10) & _
Chr(10) & "Erreur Numéro: " & Err & _
Chr(10) & "Description: " & Error()

MsgBox vtMessage, vbInformation, ctByg

Resume lbTidy

End Sub



Cordialement
Francky