como guardar con fecha actual
Publicado por edgar (27 intervenciones) el 11/04/2008 07:21:19
hola, tengo un programa que tiene un formulario con un list que automaticamente carga las fechas que hay en la base de datos y tengo que seleccionar las fechas que quiero respaldar en total en la unidad p que tengo en una red, pero lo que quiero hacer ahora es que me respalde de forma automatica la fecha del dia, ya no quiero seleccionar nada solo directamente la fecha del dia actual.
les paso el codigo completo del formulario donde tiene el list.
todo este codigo lo tengo con el boton guardar
rutaresp = "p:"
PVOpciones_Inventaio.Enabled = False
PVUnidadrespaldo_inv.MousePointer = 11
On Error GoTo controlerror ' Activa la rutina de control de errores.
MkDir "C:windowsPollo FelizRespaldos"
On Error GoTo 0 ' Desactiva la detección de errores.
hora_hoy = Format(Time, "hh_mm")
fecha_hoy = Format(Date, "dd_mm_yy")
de = "C:windowsoficina.mdb"
para = "C:windowsPollo FelizRespaldos" + nom_suc + "Inventarios" + "_" + fecha_hoy + "_" + hora_hoy + ".mdb"
If parared = 1 Then
On Error GoTo controlerror ' Activa la rutina de control de errores.
MkDir Mid(rutaresp, 1, 2) + "" + "Pv Traslados"
MkDir Mid(rutaresp, 1, 2) + "" + "Pv TrasladosInventarios"
On Error GoTo 0 ' Desactiva la detección de errores.
rutared = Mid(rutaresp, 1, 2) + "Pv TrasladosInventarios" + UCase(Format(Date, "dddd ")) + Format(Date, "dd-mm-yy")
On Error GoTo controlerror ' Activa la rutina de control de errores.
MkDir rutared
On Error GoTo 0 ' Desactiva la detección de errores.
parazip = rutared + "" + nom_suc + " " + fecha_hoy + " " + hora_hoy + " " + "Inventarios.mdb"
Else
parazip = Mid(rutaresp, 1, 2) + "" + nom_suc + "Inventarios.mdb"
End If
On Error GoTo controlerror ' Activa la rutina de control de errores.
FileCopy de, para
On Error GoTo 0 ' Desactiva la detección de errores.
Set basedatosA = OpenDatabase(para)
Set basedatos = OpenDatabase(ruta)
For iseleccion = 0 To PVOpciones_Inventaio.List1.ListCount - 1
If PVOpciones_Inventaio.List1.Selected(iseleccion) Then
Call AbreBaseDatos(basedatos, rstguardar, "select * from inventario_fecha where fecha = datevalue('" + PVOpciones_Inventaio.List1.List(iseleccion) + "') ", Lectura)
Call AbreBaseDatos(basedatosA, rstA, "select * from inventario_fecha", Escritura)
While Not rstguardar.EOF
rstA.AddNew
folio = rstguardar![folio_inv]
rstA![fecha] = rstguardar![fecha]
rstA![total_inv] = rstguardar![total_inv]
rstA![sum_efect] = rstguardar![sum_efect]
rstA![notas] = rstguardar![notas]
rstA![falt_sob] = rstguardar![falt_sob]
rstA![numart] = rstguardar![numart]
rstA![folio_inv] = rstguardar![folio_inv]
rstA![nom_suc] = rstguardar![nom_suc]
rstA![nombre_cajera] = rstguardar![nombre_cajera]
rstA![totalcf] = rstguardar![totalcf]
rstA.Update
Call AbreBaseDatos(basedatos, rstguardar1, "select * from inventario where id_inventario = val('" + folio + "') ", Lectura)
Call AbreBaseDatos(basedatosA, rstA1, "select * from inventario ", Escritura)
While Not rstguardar1.EOF
rstA1.AddNew
rstA1![id_articulo] = rstguardar1![id_articulo]
rstA1![invent_ini] = rstguardar1![invent_ini]
rstA1![invent_fin] = rstguardar1![invent_fin]
rstA1![ventas] = rstguardar1![ventas]
rstA1![prec_unit] = rstguardar1![prec_unit]
rstA1![TOTAL_PROD] = rstguardar1![TOTAL_PROD]
rstA1![id_inventario] = rstguardar1![id_inventario]
rstA1![entradas] = rstguardar1![entradas]
rstA1![id_fecha] = rstguardar![fecha]
rstA1.Update
rstguardar1.MoveNext
Wend
rstguardar.MoveNext
Wend
rstguardar.Close
rstA.Close
rstguardar1.Close
rstA1.Close
If PVOpciones_Inventaio.modificar.Visible = False Then
Else
PVInventario.Enabled = True
End If
PVOpciones_Inventaio.Enabled = True
ban = 1
End If
Next iseleccion
basedatosA.Close
basedatos.Close
'basedatos_conf.Close
'basedatos_confA.Close
On Error GoTo controlerror ' Activa la rutina de control de errores.
FileCopy para, parazip
On Error GoTo 0 ' Desactiva la detección de errores.
'On Error GoTo ControlError ' Activa la rutina de control de errores.
' FileCopy de_conf, parazip_conf
'On Error GoTo 0 ' Desactiva la detección de errores.
MsgBox "Información Guardada con éxito", vbInformation, "Pulse Aceptar"
If ban = 1 Then
Set basedatos = OpenDatabase(ruta)
PVOpciones_Inventaio.MousePointer = 0
resp = MsgBox("Depurar datos", vbOKCancel + vbQuestion, "Advertencia")
If resp = vbOK Then
PVUnidadrespaldo_inv.MousePointer = 11
For iseleccion = 0 To PVOpciones_Inventaio.List1.ListCount - 1
If PVOpciones_Inventaio.List1.Selected(iseleccion) Then
Call AbreBaseDatos(basedatos, rsteliminainv, "select * from inventario_fecha where fecha = datevalue('" + PVOpciones_Inventaio.List1.List(iseleccion) + "') ", Escritura)
folio = rsteliminainv![folio_inv]
Call AbreBaseDatos(basedatos, rstinvdet, "select * from inventario where id_inventario = val('" + folio + "') ", Escritura)
While Not rstinvdet.EOF
rstinvdet.Delete
rstinvdet.MoveNext
Wend
rsteliminainv.Delete
rstinvdet.Close
rsteliminainv.Close
id_fecha =datevalue('" + PVOpciones_Inventaio.List1.List(iseleccion) + "')", Escritura)
'rst_conf.Delete
'rst_conf.Close
End If
Next iseleccion
basedatos.Close
Unload Me
Unload PVOpciones_Inventaio
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
Else
Unload Me
basedatos.Close
Unload PVOpciones_Inventaio
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
PVUnidadrespaldo_inv.MousePointer = 0
End If
Else
Unload Me
End If
controlerror: ' Rutina de control de errores.
Select Case Err.Number ' Evalúa el número de error.
Case 57
Msg = " El dispositivo no esta listo"
MsgBox Msg, , "Prueba de error retardada"
Err.Clear ' Borra campos del objeto Err
Case 61
resp = MsgBox("Inserte otro disco", vbCritical + vbRetryCancel, "El disco esta lleno")
If resp = vbRetry Then
Resume
Else
PVMenu_2.SetFocus
End If
Case 70
resp = MsgBox("El disco esta protegido contra escritura", vbCritical + vbRetryCancel, "Revise su disco")
If resp = vbRetry Then
Resume
Else
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
End If
Case 5156
resp = MsgBox("El dispositivo no esta listo, por favor inserte el disco", vbCritical + vbOKCancel, " Error")
If resp = vbOK Then
Call PVOpciones_Inventaio.btn_Imprimir_Click
Else
PVMenu_3.Enabled = True
MsgBox "El Inventario no se Guardó en el disco", vbInformation + vbOKOnly, "Cancelado"
Unload Me
'Exit Sub
End If
Case 71
resp = MsgBox("Inserte el disco en la Unidad Seleccionada", vbCritical + vbRetryCancel, "El dispositivo no esta listo")
If resp = vbRetry Then
Resume
Else
Unload PVOpciones_Inventaio
Unload Me
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
ban = 0
End If
Case 75
Resume Next
Case 76
resp = MsgBox("Usted esta desconectado de la Red", vbRetryCancel, "Verifique Su conexion")
If resp = vbRetry Then
Resume
Else
Unload PVOpciones_Inventaio
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
Unload Me
End If
Case Else
'MsgBox "Inserte el disco en la unidad A:", vbCritical + vbOKOnly, "El dispositivo no esta listo"
End Select
les paso el codigo completo del formulario donde tiene el list.
todo este codigo lo tengo con el boton guardar
rutaresp = "p:"
PVOpciones_Inventaio.Enabled = False
PVUnidadrespaldo_inv.MousePointer = 11
On Error GoTo controlerror ' Activa la rutina de control de errores.
MkDir "C:windowsPollo FelizRespaldos"
On Error GoTo 0 ' Desactiva la detección de errores.
hora_hoy = Format(Time, "hh_mm")
fecha_hoy = Format(Date, "dd_mm_yy")
de = "C:windowsoficina.mdb"
para = "C:windowsPollo FelizRespaldos" + nom_suc + "Inventarios" + "_" + fecha_hoy + "_" + hora_hoy + ".mdb"
If parared = 1 Then
On Error GoTo controlerror ' Activa la rutina de control de errores.
MkDir Mid(rutaresp, 1, 2) + "" + "Pv Traslados"
MkDir Mid(rutaresp, 1, 2) + "" + "Pv TrasladosInventarios"
On Error GoTo 0 ' Desactiva la detección de errores.
rutared = Mid(rutaresp, 1, 2) + "Pv TrasladosInventarios" + UCase(Format(Date, "dddd ")) + Format(Date, "dd-mm-yy")
On Error GoTo controlerror ' Activa la rutina de control de errores.
MkDir rutared
On Error GoTo 0 ' Desactiva la detección de errores.
parazip = rutared + "" + nom_suc + " " + fecha_hoy + " " + hora_hoy + " " + "Inventarios.mdb"
Else
parazip = Mid(rutaresp, 1, 2) + "" + nom_suc + "Inventarios.mdb"
End If
On Error GoTo controlerror ' Activa la rutina de control de errores.
FileCopy de, para
On Error GoTo 0 ' Desactiva la detección de errores.
Set basedatosA = OpenDatabase(para)
Set basedatos = OpenDatabase(ruta)
For iseleccion = 0 To PVOpciones_Inventaio.List1.ListCount - 1
If PVOpciones_Inventaio.List1.Selected(iseleccion) Then
Call AbreBaseDatos(basedatos, rstguardar, "select * from inventario_fecha where fecha = datevalue('" + PVOpciones_Inventaio.List1.List(iseleccion) + "') ", Lectura)
Call AbreBaseDatos(basedatosA, rstA, "select * from inventario_fecha", Escritura)
While Not rstguardar.EOF
rstA.AddNew
folio = rstguardar![folio_inv]
rstA![fecha] = rstguardar![fecha]
rstA![total_inv] = rstguardar![total_inv]
rstA![sum_efect] = rstguardar![sum_efect]
rstA![notas] = rstguardar![notas]
rstA![falt_sob] = rstguardar![falt_sob]
rstA![numart] = rstguardar![numart]
rstA![folio_inv] = rstguardar![folio_inv]
rstA![nom_suc] = rstguardar![nom_suc]
rstA![nombre_cajera] = rstguardar![nombre_cajera]
rstA![totalcf] = rstguardar![totalcf]
rstA.Update
Call AbreBaseDatos(basedatos, rstguardar1, "select * from inventario where id_inventario = val('" + folio + "') ", Lectura)
Call AbreBaseDatos(basedatosA, rstA1, "select * from inventario ", Escritura)
While Not rstguardar1.EOF
rstA1.AddNew
rstA1![id_articulo] = rstguardar1![id_articulo]
rstA1![invent_ini] = rstguardar1![invent_ini]
rstA1![invent_fin] = rstguardar1![invent_fin]
rstA1![ventas] = rstguardar1![ventas]
rstA1![prec_unit] = rstguardar1![prec_unit]
rstA1![TOTAL_PROD] = rstguardar1![TOTAL_PROD]
rstA1![id_inventario] = rstguardar1![id_inventario]
rstA1![entradas] = rstguardar1![entradas]
rstA1![id_fecha] = rstguardar![fecha]
rstA1.Update
rstguardar1.MoveNext
Wend
rstguardar.MoveNext
Wend
rstguardar.Close
rstA.Close
rstguardar1.Close
rstA1.Close
If PVOpciones_Inventaio.modificar.Visible = False Then
Else
PVInventario.Enabled = True
End If
PVOpciones_Inventaio.Enabled = True
ban = 1
End If
Next iseleccion
basedatosA.Close
basedatos.Close
'basedatos_conf.Close
'basedatos_confA.Close
On Error GoTo controlerror ' Activa la rutina de control de errores.
FileCopy para, parazip
On Error GoTo 0 ' Desactiva la detección de errores.
'On Error GoTo ControlError ' Activa la rutina de control de errores.
' FileCopy de_conf, parazip_conf
'On Error GoTo 0 ' Desactiva la detección de errores.
MsgBox "Información Guardada con éxito", vbInformation, "Pulse Aceptar"
If ban = 1 Then
Set basedatos = OpenDatabase(ruta)
PVOpciones_Inventaio.MousePointer = 0
resp = MsgBox("Depurar datos", vbOKCancel + vbQuestion, "Advertencia")
If resp = vbOK Then
PVUnidadrespaldo_inv.MousePointer = 11
For iseleccion = 0 To PVOpciones_Inventaio.List1.ListCount - 1
If PVOpciones_Inventaio.List1.Selected(iseleccion) Then
Call AbreBaseDatos(basedatos, rsteliminainv, "select * from inventario_fecha where fecha = datevalue('" + PVOpciones_Inventaio.List1.List(iseleccion) + "') ", Escritura)
folio = rsteliminainv![folio_inv]
Call AbreBaseDatos(basedatos, rstinvdet, "select * from inventario where id_inventario = val('" + folio + "') ", Escritura)
While Not rstinvdet.EOF
rstinvdet.Delete
rstinvdet.MoveNext
Wend
rsteliminainv.Delete
rstinvdet.Close
rsteliminainv.Close
id_fecha =datevalue('" + PVOpciones_Inventaio.List1.List(iseleccion) + "')", Escritura)
'rst_conf.Delete
'rst_conf.Close
End If
Next iseleccion
basedatos.Close
Unload Me
Unload PVOpciones_Inventaio
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
Else
Unload Me
basedatos.Close
Unload PVOpciones_Inventaio
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
PVUnidadrespaldo_inv.MousePointer = 0
End If
Else
Unload Me
End If
controlerror: ' Rutina de control de errores.
Select Case Err.Number ' Evalúa el número de error.
Case 57
Msg = " El dispositivo no esta listo"
MsgBox Msg, , "Prueba de error retardada"
Err.Clear ' Borra campos del objeto Err
Case 61
resp = MsgBox("Inserte otro disco", vbCritical + vbRetryCancel, "El disco esta lleno")
If resp = vbRetry Then
Resume
Else
PVMenu_2.SetFocus
End If
Case 70
resp = MsgBox("El disco esta protegido contra escritura", vbCritical + vbRetryCancel, "Revise su disco")
If resp = vbRetry Then
Resume
Else
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
End If
Case 5156
resp = MsgBox("El dispositivo no esta listo, por favor inserte el disco", vbCritical + vbOKCancel, " Error")
If resp = vbOK Then
Call PVOpciones_Inventaio.btn_Imprimir_Click
Else
PVMenu_3.Enabled = True
MsgBox "El Inventario no se Guardó en el disco", vbInformation + vbOKOnly, "Cancelado"
Unload Me
'Exit Sub
End If
Case 71
resp = MsgBox("Inserte el disco en la Unidad Seleccionada", vbCritical + vbRetryCancel, "El dispositivo no esta listo")
If resp = vbRetry Then
Resume
Else
Unload PVOpciones_Inventaio
Unload Me
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
ban = 0
End If
Case 75
Resume Next
Case 76
resp = MsgBox("Usted esta desconectado de la Red", vbRetryCancel, "Verifique Su conexion")
If resp = vbRetry Then
Resume
Else
Unload PVOpciones_Inventaio
PVMenu_2.Enabled = True
PVMenu_2.SetFocus
Unload Me
End If
Case Else
'MsgBox "Inserte el disco en la unidad A:", vbCritical + vbOKOnly, "El dispositivo no esta listo"
End Select
Valora esta pregunta


0