Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Access » Crear Carpetas y subcarpetas

Access - Crear Carpetas y subcarpetas

Volver
Nuevo Tema
<<>>
 
Vista:

Crear Carpetas y subcarpetas

Publicado por Elkin (6 intervenciones) el 09/04/2019 17:04:01
Buenas a todos, soy un poco nuevo en Access

quien me podria ayuda con el siguiente tema, tengo una carpeta principal en la unidad D: que se llama LBerlin, y quiero que al momento de abrir la aplicación detecte si estan credas unas carpetas de la siguiente forma

D:\LBerlin\Tablas

D:\LBerlin\Tablas\Ano\2019
D:\LBerlin\Tablas\Ano\2019\mes01
D:\LBerlin\Tablas\Ano\2019\mes02...... mes12

Si no estan creadas como hago para crearlas, cuando llegue el siguiente Año(2020) cree las carpetas correspondientes

D:\LBerlin\Tablas\Ano\2020
D:\LBerlin\Tablas\Ano\2020\mes01
D:\LBerlin\Tablas\Ano\2020\mes02...... mes12

Tengo este codigo pero no me crea la carpeta mes01....mes12 dentro de la carpeta Ano\2019...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Form_Load()
    Dim strTempCarpeta As String
    Dim strNombreMes, strNombreAno As String
 
    strNombreMes = Format(Date, "MM")
    strNombreAno = Format(Date, "YYYY")
 
    If Len(Dir("D:\LBerlin\Tablas\Ano", vbDirectory)) = 0 Then
        MkDir "D:\LBerlin\Tablas\Ano"
        MkDir "D:\LBerlin\Tablas\Ano\" & strNombreAno
        MkDir "D:\LBerlin\Tablas\Ano\" & "mes" & strNombreMes
      Else
       MsgBox "Existe"
    End If
End Sub
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
sin imagen de perfil
Val: 756
Plata
Ha mantenido su posición en Access (en relación al último mes)
Gráfica de Access

Crear Carpetas y subcarpetas

Publicado por Jesús Manuel (375 intervenciones) el 10/04/2019 08:37:46
Tal y como tienes el código solo compruebas que exista la carpeta con ruta D:\LBerlin\Tablas\Ano y si no existe creas 3 carpetas:

D:\LBerlin\Tablas\Ano
D:\LBerlin\Tablas\Ano\2019
D:\LBerlin\Tablas\Ano\mes04

(Con la fecha a día de hoy), las 2 últimas dentro de D:\LBerlin\Tablas\Ano, ni siquiera con la estructura de tablas que deseas.
Non se para que sirve la variable strTempCarpeta, que defines como string, pero no aparece luego en el código.

Prueba con:

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
Dim strTempCarpeta As String
Dim strNombreMes, strNombreAno As String
 
strNombreMes = Format(Date, "MM")
strNombreAno = Format(Date, "YYYY")
strTempCarpeta = "D:\LBerlin\Tablas\Ano\"
 
If Len(Dir(strTempCarpeta, vbDirectory)) = 0 Then ' si no existe la carpeta \Ano la creamos

    MkDir strTempCarpeta
 
    If Len(Dir(strTempCarpeta & strNombreAno, vbDirectory)) = 0 Then ' si no existe la carpeta con el numero del año la creamos dentro de \Ano

        MkDir strTempCarpeta & strNombreAno
 
        If Len(Dir(strTempCarpeta & strNombreAno & "\mes" & strNombreMes, vbDirectory)) = 0 Then ' si no existe la carpeta del mesXX la creamos dentro de \ano\20XX

            MkDir strTempCarpeta & strNombreAno & "\mes" & strNombreMes
        End If
    Else ' si existe \Ano\20XX comprobamos si existe la carpeta del mesXX y la creamos si no existe

        If Len(Dir(strTempCarpeta & strNombreAno & "\mes" & strNombreMes, vbDirectory)) = 0 Then
            MkDir strTempCarpeta & strNombreAno & "\mes" & strNombreMes
        End If
    End If
 
Else ' la carpeta \Ano existe, por lo que comprobamos si existe la carpeta \Ano\20XX y en caso de no existir la creamos

    If Len(Dir(strTempCarpeta & strNombreAno, vbDirectory)) = 0 Then
        MkDir strTempCarpeta & strNombreAno
 
        If Len(Dir(strTempCarpeta & strNombreAno & "\mes" & strNombreMes, vbDirectory)) = 0 Then 'Tenemos la ruta hasta \Ano\20XX y comprobamos si existe la del mesXX 

            MkDir strTempCarpeta & strNombreAno & "\mes" & strNombreMes
        End If
    Else ' Existe \Ano\20XX, comprobamos si existe el mesXX y la creamos si no existe

        If Len(Dir(strTempCarpeta & strNombreAno & "\mes" & strNombreMes, vbDirectory)) = 0 Then
            MkDir strTempCarpeta & strNombreAno & "\mes" & strNombreMes
        End If
    End If
 
End If
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

Crear Carpetas y subcarpetas

Publicado por Elkin (6 intervenciones) el 10/04/2019 17:32:29
Muchas gracias

Agradezco su pronta respuesta la cual me resulto muy útil y satisfactoria con la cual pude resolver el impase que tenía.
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

Crear Carpetas y subcarpetas

Publicado por Elkin (6 intervenciones) el 13/04/2019 00:45:12
Buenas tardes

Siguiendo con mi aprendizaje quise hacer algo adicional al código después de estudiarlo, y copiar un archivo en cada carpeta que exista o no
pero me sale un error de:

se requiere un objeto error 424

Dígito la fecha y la guardo en ( AnoNuevo), Adjunto código para su amable ayuda y saber donde esta el error que cometo..

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
Private Sub CrearAno_Click()
 
    If MsgBox("Esta seguro de crear el Nuevo Año para el proceso de facturación", vbYesNo + vbInformation, "Crear Año nuevo") = vbYes Then
       Dim strTempCarpeta, strTempCarpeta1 As String
       Dim strNombreMes, strNombreAno, txtFile As String
 
       txtFile = Trim("D:\LBerlin\ArchvBlanco\BaseFactura.MDB")
 
       strNombreMes = Format(AnoNuevo, "MM")
       strNombreAno = Format(AnoNuevo, "YYYY")
 
       strTempCarpeta = "D:\LBerlin\Tablas\Ano\"
 
       If Len(Dir(strTempCarpeta, vbDirectory)) = 0 Then ' si no existe la carpeta \Ano la creamos

           MkDir strTempCarpeta
 
           If Len(Dir(strTempCarpeta & strNombreAno, vbDirectory)) = 0 Then ' si no existe la carpeta con el numero del año la creamos dentro 

                                                                                                                       'de \Ano También creamos las 12 carpetas de los meses

               MkDir strTempCarpeta & strNombreAno
 
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "01"
 
                   strTempCarpeta1 = strTempCarpeta & strNombreAno & "\mes01"
                   FileCopy "D:\LBerlin\ArchvBlanco\BaseFactura.MDB", strTempCarpeta1 & BaseFactura.MDB 'Copio el archivo BaseFactura

                                                                                                                                                                         'y es donde me sale el error                 

                   MkDir strTempCarpeta & strNombreAno & "\mes" & "02"
 
                   strTempCarpeta1 = strTempCarpeta & strNombreAno & "\mes02"
                   FileCopy "D:\LBerlin\ArchvBlanco\BaseFactura.MDB", strTempCarpeta1 & BaseFactura.MDB
 
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "03"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "04"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "05"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "06"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "07"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "08"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "09"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "10"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "11"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "12"
 
            Else ' si existe \Ano\20XX comprobamos si existe la carpeta del mesXX y la creamos si no existe

 
               If Len(Dir(strTempCarpeta & strNombreAno & "\mes" & strNombreMes, vbDirectory)) = 0 Then
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "01"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "02"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "03"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "04"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "05"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "06"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "07"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "08"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "09"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "10"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "11"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "12"
               End If
           End If
 
         Else ' la carpeta \Ano existe, por lo que comprobamos si existe la carpeta \Ano\20XX y en caso de no existir la creamos

              ' Tambien creamos las 12 carpetas de los meses

            'MsgBox "Si Existe la carpeta Año"

 
           If Len(Dir(strTempCarpeta & strNombreAno, vbDirectory)) = 0 Then ' si no existe la carpeta con el numero del año la creamos dentro de \Ano

               MkDir strTempCarpeta & strNombreAno
 
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "01"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "02"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "03"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "04"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "05"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "06"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "07"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "08"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "09"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "10"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "11"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "12"
 
            Else ' si existe \Ano\20XX comprobamos si existe la carpeta del mesXX y la creamos si no existe

               If Len(Dir(strTempCarpeta & strNombreAno & "\mes" & strNombreMes, vbDirectory)) = 0 Then
 
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "01"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "02"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "03"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "04"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "05"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "06"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "07"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "08"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "09"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "10"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "11"
                   MkDir strTempCarpeta & strNombreAno & "\mes" & "12"
               End If
           End If
       End If
     Else
        MsgBox "operacion cancelda", vbInformation, "Crear Año Nuevo"
    End If
End Sub
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
Imágen de perfil de Norberto
Val: 1.094
Oro
Ha mantenido su posición en Access (en relación al último mes)
Gráfica de Access

Crear Carpetas y subcarpetas

Publicado por Norberto (753 intervenciones) el 15/04/2019 15:51:33
Hola.

Lo que debes de hacer es crear un módulo y pegar en él el código del procedimiento xMkDir que te envié. Luego debes de usarlo de la siguiente manera:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub CrearAno_Click()
    If MsgBox("Esta seguro de crear el Nuevo Año para el proceso de facturación", vbYesNo + vbInformation, "Crear Año nuevo") = vbYes Then
        Dim strTempCarpeta, strTempCarpeta1 As String
        Dim strNombreMes, strNombreAno, txtFile As String
        Dim Mes As Integer
 
 
        txtFile = Trim("D:\LBerlin\ArchvBlanco\BaseFactura.MDB")
        strNombreMes = Format(AnoNuevo, "MM")
        strNombreAno = Format(AnoNuevo, "YYYY")
        strTempCarpeta = "D:\LBerlin\Tablas\Ano\"
 
        For Mes = 1 To 12
            xMkDir strTempCarpeta & strNombreAno & "\mes" & Format(Mes, "00")
        Next
    Else
        MsgBox "operacion cancelda", vbInformation, "Crear Año Nuevo"
    End If
End Sub

Luego copias las BdD. No tienes que comprobar si existen o no las carpetas, el procedimiento xMkDir se encarga de ello.

Un saludo,

Norberto.
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
Imágen de perfil de Norberto
Val: 1.094
Oro
Ha mantenido su posición en Access (en relación al último mes)
Gráfica de Access

Crear Carpetas y subcarpetas

Publicado por Norberto (753 intervenciones) el 10/04/2019 09:57:12
Hola.

Yo uso este procedimiento:

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
Public Sub xMkDir(ByVal Path As String) 'Igual que MkDir pero comprueba si existe el directorio

    Dim Ruta As String, NuevaCarpeta As String, i As Integer
    On Error GoTo xMkDir_Error
    If Right(Path, 1) = "\" Then Path = Left(Path, Len(Path) - 1) 'Quitamos un posible \ al final del path

    If Dir(Path, vbDirectory + vbHidden) <> "" Then Exit Sub 'Si ya existe, salimos

    i = InStrRev(Path, "\") 'Averiguanos dónde está la última \

    Ruta = Left(Path, i)  'La ruta es lo que está a su izquierda

    NuevaCarpeta = Mid(Path, i + 1) 'La nueva carpeta lo de su derecha

    If Left(Ruta, 2) = "\\" Then 'Es un recurso de red

        i = InStr(3, Ruta, "\")     'Averiguamos dónde acaba el nombre

        i = InStr(i + 1, Ruta, "\") 'del recurso compartido, que no se puede crear

        If i < Len(Ruta) Then 'Si la ruta es más que el nombre del \\servidor\recursocompartido\...

            xMkDir Ruta 'Llamamos recursivamente para crear la carpeta anterior

        End If
    Else    'Es una unidad local

        If Right(Ruta, 2) <> ":\" Then 'La ruta está una unidad local y quedan carpetas por recorrer

            xMkDir Ruta 'Llamamos recursivamente para crear la carpeta anterior

        End If
    End If
    'Comprobamos que se haya creado la ruta anterior

    If Dir(Ruta & "*.*", vbDirectory + vbHidden) <> "" Then
        MkDir Ruta & NuevaCarpeta 'Creamos la última carpeta

    Else
        'Error 52

    End If
    GoTo xMkDir_Fin
xMkDir_Error:
    If Err = 52 Then
        MsgBox "No se ha podido acceder a la ruta especificada. " & _
               "Es posible que la unidad de disco local o el recurso compartido de red no existan." & _
               vbCrLf & vbCrLf & _
               Path
    Else
        On Error GoTo 0 'Esto lo hago por si se produce otro error poder ver cúal es y dónde.

        Resume
    End If
 
xMkDir_Fin:
End Sub

Un saludo,

Norberto.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar

Crear Carpetas y subcarpetas

Publicado por Elkin (6 intervenciones) el 10/04/2019 17:33:06
Muchas gracias

Agradezco su pronta respuesta la cual me resulto muy útil y satisfactoria con la cual pude resolver el impase que tenía.
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