Foros del Web - Ver Mensaje Individual

fesero · #8 (**permalink**) 17/11/2010, 05:07

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