Visual Basic - como guardar con la fecha actual

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

te agradesco, pero eso no me sirve, si te das cuenta ya uso esa funcion para que me de la hora.

pero lo que quiero saber es como cambiar para que en vez que me jale el las fechas de las bases de datos con el list no haga eso, cambiar el codigo del list y poner el codigo para que me de la fecha automatica y respaldarla.

presentia que no hiban a entender el codigo, veo que hace falta un experto por esta area.


gracias

Si ya usas Date y Time para la hora y usa Now