Visual Basic para Aplicaciones - Error en código

Life is soft - evento anual de software empresarial
   
Vista:

Error en código

Publicado por Miguel (1 intervención) el 02/10/2014 09:57:17
Hola, he creado este código para actualizar una tabla de Access mediante un fichero Excel, pero no funciona... La negrita creo que es donde puede estar el error, si alguien le puede echar un vistazo me iría de maravilla!!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Private Sub cmdActualizarPHS_Click()
'Arreglar de la tabla todos modelos los que no tenian la información
On Error GoTo Err_ArreglarDatos
    Dim sql As String
    Dim model As String
    Dim stDocName As String
    Dim TBL As Recordset
    Dim TBL1 As Recordset
    Dim TBL2 As Recordset
    Dim sFuente As String, sSet As String, sDeno As String
    Dim sFaseProyecto As String, sSituacion As String, sFechaRevision As String, sZonaProcesos As String
    Dim sDesmontaje As String, sFuenteTBL1 As String
    Dim ObjExcel As Object
    Dim lFilaPHs As Long, lFilaPHSNuevo As Long, lFilaPHSContado As Long
    Dim kk As Integer
 
    'Debug.Print "PASO 1"
    'stDocName = "modelo"
    'Lanzar la macro con nombre modelo: (Introduce el modelo en la tabla modelo: 'INSERT INTO modelo (modelo) VALUES(Formularios![nuevo_modelo]![Modelo] ),)
    'DoCmd.RunMacro stDocName
 
    'Establecer db como la base de datos actual
    Set db = CurrentDb
    'Establecer TBL como la tabla de PHS_Desm
    sql = "SELECT * FROM PHS_Desm"
    Set TBL = db.OpenRecordset(sql)
 
    'Establecer TBL1 como la tabla todos los modelos
    sql = "SELECT * FROM Todosmodelos"
    Set TBL1 = db.OpenRecordset(sql)
    'Debug.Print "PASO 2"
 
    If Opcion0.Value = True Then
 
        'DefinirRuta
        'sRutaDefinitiva = "\\vfesseatmarp\PP\PP_2\PP_2FD\Compartida\03_Presentaciones\6.-Control proyecto\PHS\actualizaciones_PHS\wissenswerk" & txtRutaFichero.Value & ".xls"
        sRutaDefinitiva = "C:\Temp\" & txtRutaFichero.Value & ".xls"
        'Abrir excel
        Set ObjExcel = CreateObject("Excel.Application")
 
        ObjExcel.Workbooks.Open FileName:=sRutaDefinitiva
 
        lFilas = 1
        Do Until ObjExcel.Range("A" & lFilas).Value = ""
            lFilas = lFilas + 1
 
            If ObjExcel.Range("A" & lFilas).Value = "" Then
                Exit Sub
            End If
 
            sPHS = "PHS_" & ObjExcel.Range("A" & lFilas)
            If sPHS = "PHS_111" Then
                aa = aa
            End If
 
            sSituacion = ObjExcel.Range("B" & lFilas)
            sFechaRevision = ObjExcel.Range("C" & lFilas)
            sDenominacion = ObjExcel.Range("D" & lFilas)
            sDenominacion = Replace(sDenominacion, "'", "")
            sFaseProyecto = ObjExcel.Range("E" & lFilas)
            sZonaProcesos = ObjExcel.Range("F" & lFilas)
            sSet = ObjExcel.Range("G" & lFilas)
 
            TBL.MoveFirst
            sExiste = False
            lFilaPHSNuevo = 0
            Do Until TBL.EOF
                If sPHS = TBL1(Fuente) Then
                    'sql = "Update Todosmodelos SET (Situacion ='" & sSituacion & "', Fecha ='" & sFechaRevision & "', FP ='" & sFaseProyecto & "', ZP ='" & sZonaProcesos & '") WHERE Id_PHS_Desm =" & lFilaPHs & ";"
                    'db.Execute (sql)
                    DoCmd.RunSQL "Update Todosmodelos SET Situacion = " & sSituacion & ", Fecha ='" & sFechaRevision & "', FP ='" & sFaseProyecto & "', ZP ='" & sZonaProcesos & "'  WHERE Id_PHS_Desm =" & lFilaPHs & ";"
                End If
                TBL.MoveNext
                lFilaPHSNuevo = lFilaPHSNuevo + 1
            Loop
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder