Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Access » Duda código VBA

Access - Duda código VBA

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

Duda código VBA

Publicado por Miguel (29 intervenciones) el 12/10/2014 15:24:20
Hola estoy con un programa para una bbdd, lo copio abajo por si alguien le puede echar un vistazo, lo que hay que mirar es lo que está en negrita solo.
Resumiendo, tengo un excel con 3 columnas de datos (sPHS, sSet, sDenominacion), tengo que mirar si el primer registro del Excel de la columna sPHS ya existe en la bbdd, entonces actualizar los datos de set y denominacion. En caso de que no exista, crear un registro nuevo con esos 2 datos más el propio sPHS y el id_phs_desm.

Como no domino mucho el tema no sé si lo habré hecho bien.. yo creo que el fallo puede estar en que solo mira que el registro primero del excel coincida con el primero del access, y no mira todos...pero no sé cómo hacerlo..


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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
Option Compare Database
 
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] ), Sí)

    '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 & ".xlsx"

        'sRutaDefinitiva = "C:\Temp\" & txtRutaFichero.Value & ".xls"

        sRutaDefinitiva = "C:\Users\MIGUEL\Desktop\" & txtRutaFichero.Value & ".xlsx"
        '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 = ObjExcel.Range("A" & lFilas)
            sDenominacion = ObjExcel.Range("C" & lFilas)
            sDenominacion = Replace(sDenominacion, "'", "")
            sSet = ObjExcel.Range("B" & lFilas)
 
            TBL.MoveFirst
            lFilaPHs = 0
 
            Do Until TBL.EOF
 
                If sPHS = TBL("fuen") Then  'Si el campo de Excel es igual al de la tabla, solo tiene que actualizar

                        lFilaPHs = TBL("Id_phs_desm")
 
                        If sDenominacion <> "" And sDenominacion <> TBL("Deno") Then    'si en el excel no está vacío y es diferente del campo de la tabla actualiza

                            'Actualizar la tabla PHS_DESM

                            sql = "Update PHS_DESM SET Deno ='" & sDenominacion & "' WHERE Id_PHS_Desm =" & lFilaPHs & ";"
                            db.Execute (sql)
                            'Actualizar la tabla Todosmodelos

                            sql = "Update Todosmodelos SET Deno ='" & sDenominacion & "' WHERE Id_PHS_Desm =" & lFilaPHs & ";"
                            db.Execute (sql)
                        End If
 
                        If sSet <> "" And sSet <> TBL("sete") Then  'si en el excel no está vacío y es diferente del campo de la tabla actualiza

                            'Actualizar la tabla PHS_DESM

                            sql = "Update PHS_DESM SET Sete ='" & sSet & "' WHERE Id_PHS_Desm =" & lFilaPHs & ";"
                            db.Execute (sql)
                            'Actualizar la tabla Todosmodelos

                            sql = "Update Todosmodelos SET Sete ='" & sSet & "' WHERE Id_PHS_Desm =" & lFilaPHs & ";"
                            db.Execute (sql)
                        End If
                Loop    'vuelve al do until mirando el siguiente registro de TBL

                Else    'si el campo de Excel es diferente al campo Deno de TBL tiene que crear un registro nuevo

                        idcod = DMax("Id_phs_desm", "Todosmodelos") + 1
                        sRuta = "\\vfesseatmarp\PP\PP_2\PP_2FD\Compartida\03_Presentaciones\6.-Control proyecto\Desmontajes\" & sPHS & sDenominacion
                        sRuta = sPHS & "#" & sRuta & "#"
                        sql = "INSERT INTO PHS_DESM (Id_PHS_Desm,fuen,sete,Deno) VALUES (" & idcod & ",'" & sRuta & "','" & sSet & "','" & sDenominacion & "');"
                        db.Execute (sql)
                            'insertar en TodosModelos

                            sql = "SELECT * FROM Modelo"
                            Set TBL2 = db.OpenRecordset(sql)
                            TBL2.MoveFirst
                            'Debug.Print "PASO 3.3"

                            Do Until TBL2.EOF   ' este do until es para que meta los datos en todos los modelos

                                sql = "INSERT INTO Todosmodelos (Id_PHS_Desm,Id_Proces,PHS_DESM_Proc,Modelo,Fuente,Sete,Deno) VALUES (" & idcod & "," & 0 & "," & 1 & ",'" & TBL2("Modelo") & "','" & sRuta & "','" & sSet & "','" & sDenominacion & "');"
                                db.Execute (sql)
                                TBL2.MoveNext
                            Loop
                End If
            End If
                TBL.MoveNext    'mira el siguiente registro de TBL

                lFilaPHSNuevo = lFilaPHSNuevo + 1
            Loop
            If sExiste = False Then
            'Debug.Print "PASO 3.1"

                'insertar en PHS_DESM

                idcod = DMax("Id_phs_desm", "Todosmodelos") + 1
                sRuta = "\\vfesseatmarp\PP\PP_2\PP_2FD\Compartida\03_Presentaciones\6.-Control proyecto\PHS\" & sPHS
                sRuta = sPHS & "#" & sRuta & "#"
                sql = "INSERT INTO PHS_DESM (Id_PHS_Desm,fuen,sete,Deno,FaseProyecto,Situacion,FechaRevision,ZonaProceso) VALUES (" & idcod & ",'" & sRuta & "','" & sSet & "','" & sDenominacion & "','" & sFaseProyecto & "','" & sSituacion & "','" & sFechaRevision & "','" & sZonaProceso & "');"
                db.Execute (sql)
                'insertar en TodosModelos

                'Debug.Print "PASO 3.2"

                sql = "SELECT * FROM Modelo"
                Set TBL2 = db.OpenRecordset(sql)
                TBL2.MoveFirst
                'Debug.Print "PASO 3.3"

                Do Until TBL2.EOF
                    sql = "INSERT INTO Todosmodelos (Id_PHS_Desm,Id_Proces,PHS_DESM_Proc,Modelo,Fuente,Sete,Deno,FP,Situacion,Fecha,ZP) VALUES (" & idcod & "," & 0 & "," & 1 & ",'" & TBL2("Modelo") & "','" & sRuta & "','" & sSet & "','" & sDenominacion & "','" & sFaseProyecto & "','" & sSituacion & "','" & sFechaRevision & "','" & sZonaProceso & "');"
                    db.Execute (sql)
                    TBL2.MoveNext
                Loop
                sql = "SELECT * FROM PHS_Desm"
                Set TBL = db.OpenRecordset(sql)
                'Debug.Print "PASO 3.4"

            End If
        Loop
 
            TBL1.MoveNext
        Loop
        TBL.Close
    MsgBox "Actualización realizada correctamente."
    ObjExcel.Application.Quit
    End If
 
 
 
Exit_ArreglarDatos:
    Exit Sub
 
Err_ArreglarDatos:
    MsgBox Err.Description
    Resume Exit_ArreglarDatos
End Sub
 
Private Function obtenerVacios(sDeno As Object) As String
On Error GoTo Err_obret_Click
    obtenerVacios = sDeno.Value
    Exit Function
Err_obret_Click:
obtenerVacios = ""
End Function
 
Private Sub cmdBotonMenu_Click()
    On Error GoTo Err_cmdBotonMenu_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    DoCmd.Close
    stDocName = "Inicio"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_cmdBotonMenu_Click:
    Exit Sub
 
Err_cmdBotonMenu_Click:
    MsgBox Err.Description
    Resume Exit_cmdBotonMenu_Click
 
End Sub
 
Private Sub Opcion0_Click()
Opcion2.Value = Not Opcion0.Value
End Sub
 
Private Sub Opcion2_Click()
Opcion0.Value = Not Opcion2.Value
End Sub



Saludos.
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

					
Duda código VBA
Publicado por jose (830 intervenciones) el 27/10/2014 21:50:53
se mas concreto



Tu crees que alguien va a perder el tiempo  en mirar todo ese rollo que has puesto ?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar