17/11/2010, 05:07
|
| | | Fecha de Ingreso: junio-2008 Ubicación: Punta Alta, Argentina
Mensajes: 82
Antigüedad: 16 años, 9 meses Puntos: 0 | |
| Respuesta: Error 2147217904 (80040e10)
Cita:
Iniciado por Gakex  1 primero checar que se aga la coneccion.
2 luego dices que antes extraes una información?, te da esa informacion?, si, la conexion se hace, probe con la que esta mas arriba y con la de microsoft JET, esta ultima tambien sale el mismo error en el mismo lugar pero no especifica que parametro falta..
ahora verifica esto Cita:
Iniciado por Gakex 1 cierras la conección antes de pasar a el sigiente punto que es agregar datos.?
2 aqui hay que checar los tipos de datos que vas a agregar, es decir realmente son numeros, fechas o texto?, si no pero son compatibles combertirlos.
checalo y hablamos...
pongo todo el codigo del sub donde sale el error
Código:
Private Sub cmbComp_Click()
Dim g As Integer, sTexto As String, sArchOrig As String, sArchGuar As String, sADEc As String, iX As Integer, sTexto2 As String
Set cnn = New ADODB.Connection
sFichero = "C:\z Procesador Registradores\programa.xls"
If cnn.State <> 1 Then
'With cnn
' .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & sFichero & "';Extended Properties=Excel 8.0;; " 'HDR=YES;"
' .Open
' .CursorLocation = adUseClient
'End With
With cnn
.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & Trim(sFichero) & "; ReadOnly=False;"
cnn.Open
End With
End If
Set rs = New ADODB.Recordset 'B160049
'sBus = "SELECT * FROM [datos$A1:BH150]" ' ORDER BY COD-OC"
rs.Open "SELECT * FROM [datos$A1:BH150]", cnn, adOpenDynamic, adLockOptimistic, adCmdText
Set xlsApp = CreateObject("Excel.Application")
sArchOrig = "C:\z Procesador Registradores\Orig\Planilla.xls"
sArchGuar = "C:\z Procesador Registradores\Cronograma\ "
Set xlsBook = xlsApp.Workbooks.Open(sArchOrig)
Set xlsSheet = xlsBook.Worksheets(1)
sADEc = sArchGuar & "P" & tbPer.Text & "_" & cbMes.Text & "_C" & tbCamp.Text
xlsBook.SaveAs (sADEc)
For g = 0 To 4
sTexto = Trim$(QuitaEspacios(tbCodigo(g).Text, True, True))
If chRegistrador(g).Value = 1 Then
Select Case g
Case Is = 0: iX = 0
Case Is = 1: iX = 12
Case Is = 2: iX = 12 * 2
Case Is = 3: iX = 12 * 3
Case Is = 4: iX = 12 * 4
Case Is = 5: iX = 12 * 5
End Select
sTexto2 = "S032" & sTexto
sFiltro = "[COD-OC] = '" & sTexto2 & "'"
rs.Filter = sFiltro
If rs.RecordCount = 0 Then
vComprobar(g) = 1
Else
If rs(14).Value = "B" Or rs(14).Value = "G" Then
xlsSheet.Cells(2 + iX, 7) = rs(0).Value 'codigo
xlsSheet.Cells(3 + iX, 2) = chRegistrador(g).Caption 'Nº Reg
xlsSheet.Cells(3 + iX, 5) = tbPer.Text 'periodo
xlsSheet.Cells(3 + iX, 7) = "00" 'remedido
xlsSheet.Cells(4 + iX, 2) = tbCamp.Text 'campaña
xlsSheet.Cells(4 + iX, 4) = rs(8).Value 'tarifa
xlsSheet.Cells(4 + iX, 7) = rs(9).Value 'tension
xlsSheet.Cells(5 + iX, 2) = rs(6).Value 'nombre
xlsSheet.Cells(5 + iX, 7) = rs(5).Value 'Nº Socio
xlsSheet.Cells(6 + iX, 2) = rs(7).Value 'domicilio
xlsSheet.Cells(6 + iX, 7) = rs(4).Value 'ruta
xlsSheet.Cells(7 + iX, 3) = Format(tbFecha(0).Text, "dd/mm") 'desde
xlsSheet.Cells(7 + iX, 7) = rs(15).Value 'sum
xlsSheet.Cells(10 + iX, 3) = Format(tbFecha(1).Text, "dd/mm") 'hasta
xlsSheet.Cells(11 + iX, 2) = cbVariables(g).Text 'variables
xlsSheet.Cells(11 + iX, 7) = "" 'set
xlsSheet.Cells(12 + iX, 2) = cbPinza(g).Text 'pinza
xlsSheet.Cells(12 + iX, 4) = rs(3).Value 'punto
xlsSheet.Cells(12 + iX, 6) = tbNombre(g).Text 'fichero
ElseIf rs(14).Value = "SE" Then
xlsSheet.Cells(2 + iX, 7) = rs(0).Value 'codigo
xlsSheet.Cells(3 + iX, 2) = chRegistrador(g).Caption 'Nº Reg
xlsSheet.Cells(3 + iX, 5) = tbPer.Text 'periodo
xlsSheet.Cells(3 + iX, 7) = "00" 'remedido
xlsSheet.Cells(4 + iX, 2) = tbCamp.Text 'campaña
xlsSheet.Cells(4 + iX, 4) = rs(10).Value 'potencia
xlsSheet.Cells(4 + iX, 7) = rs(11).Value 'tipo
xlsSheet.Cells(5 + iX, 2) = rs(6).Value 'nombre
xlsSheet.Cells(5 + iX, 7) = "0" 'Nº Socio
xlsSheet.Cells(6 + iX, 2) = rs(7).Value 'domicilio
xlsSheet.Cells(6 + iX, 7) = "0" 'ruta
xlsSheet.Cells(7 + iX, 3) = Format(tbFecha(0).Text, "dd/mm") 'desde
xlsSheet.Cells(7 + iX, 7) = Mid(rs(6).Value + iX, 9 + iX, 2) 'sum
xlsSheet.Cells(10 + iX, 3) = Format(tbFecha(1).Text, "dd/mm") 'hasta
xlsSheet.Cells(11 + iX, 2) = cbVariables(g).Text 'variables
xlsSheet.Cells(11 + iX, 7) = Mid(rs(6).Value + iX, 9 + iX, 2) 'set
xlsSheet.Cells(12 + iX, 2) = cbPinza(g).Text 'pinza
xlsSheet.Cells(12 + iX, 4) = rs(3).Value 'punto
xlsSheet.Cells(12 + iX, 6) = tbNombre(g).Text 'fichero
End If
vComprobar(g) = 2
If chGrabar.Value = 1 Then
Dim cmd As New ADODB.Command, sModif As String
'intento de "actualizar" el unico registro modificado
sModif = "UPDATE [datos$A1:BH150] SET [F16]=" & (rs(16).Value + 1) & ""
sModif = sModif & " ,[f17]=" & (cbMes.ListIndex + 1) & ""
sModif = sModif & " ,[f18]=" & Int(tbCamp.Text) & ""
sModif = sModif & " ,[f19]=" & (rs(16).Value) + 1 & ""
sModif = sModif & " ,[f20]='" & (chRegistrador(g).Caption) & "'"
sModif = sModif & " ,[f21]=" & Format(tbFecha(0).Text, "yyyy-mm-dd") & ""
sModif = sModif & " ,[f22]=" & Format(tbFecha(1).Text, "yyyy-mm-dd") & ""
sModif = sModif & " ,[f30]='" & (tbNombre(g).Text) & "'"
sModif = sModif & " WHERE [f0] LIKE '" & (sTexto2) & "'"
MsgBox (sModif) ' veo como queda la sentencia sql
cmd.CommandType = adCmdText
cmd.CommandText = sModif
cmd.ActiveConnection = cnn
'cmd.ActiveConnection.Open
cmd.Execute
vComprobar(g) = 3
End If
End If
Else
vComprobar(g) = 0
End If
rs.Filter = adFilterNone
Next
Dim y As Integer
For y = 0 To 4
If vComprobar(y) = 0 Then
shCuad(y).BackColor = &HFF0000
ElseIf vComprobar(y) = 1 Then
shCuad(y).BackColor = &HFF&
ElseIf vComprobar(y) = 3 Then
shCuad(y).BackColor = &H800080
Else
shCuad(y).BackColor = &HC000&
End If
shCuad(y).BackStyle = 1
Next
xlsBook.Save
xlsBook.Close
End Sub
|
