claude-vba-excel-abc/UDFs_FileSystem.bas at main · gautxori-yuyu/claude-vba-excel-abc · GitHub

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
Attribute VB_Name = "UDFs_FileSystem"
'@Folder "Funciones auxiliares"
Option Explicit

Private Const MODULE_NAME As String = "UDFs_FileSystem"

'@Description: Valida si una ruta de carpeta existe
Public Function RutaExiste(ruta As String) As Boolean
Attribute RutaExiste.VB_Description = "[UDFs_FileSystem] Valida si una ruta de carpeta existe"
Attribute RutaExiste.VB_ProcData.VB_Invoke_Func = " \n21"
    On Error Resume Next
    RutaExiste = ruta <> "" And (Dir(ruta, vbDirectory) <> "")
    On Error GoTo 0
End Function
'@Description: Determina si una ruta es de red o unidad removible
'@Scope: Privado
'@ArgumentDescriptions: ruta: Ruta a verificar
'@Returns: Boolean | True si es ruta de red o removible
Function EsRutaRemovibleORed(ruta As String) As Boolean
Attribute EsRutaRemovibleORed.VB_Description = "[UDFs_FileSystem] Determina si una ruta es de red o unidad removible"
Attribute EsRutaRemovibleORed.VB_ProcData.VB_Invoke_Func = " \n21"
    Dim fso As Object
    Dim drive As Object
    Dim driveLetter As String

    On Error Resume Next

    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Caso 1: Ruta UNC (\\servidor\compartido)
    If Left$(ruta, 2) = "\\" Then
        EsRutaRemovibleORed = True
        Exit Function
    End If

    ' Caso 2: Verificar tipo de unidad
    driveLetter = fso.GetDriveName(ruta)

    If driveLetter <> "" And fso.DriveExists(driveLetter) Then
        Set drive = fso.GetDrive(driveLetter)

        ' DriveType: 0=Unknown, 1=Removable, 2=Fixed, 3=Network, 4=CDRom, 5=RamDisk
        If drive.DriveType = 1 Or drive.DriveType = 3 Then  ' Removable o Network
            EsRutaRemovibleORed = True
        Else
            EsRutaRemovibleORed = False
        End If
    Else
        ' No se pudo determinar, asumir que es removible por seguridad
        EsRutaRemovibleORed = True
    End If

    On Error GoTo 0
End Function

'@Description: Determina si una ruta es de red (UNC o unidad mapeada)
'@Scope: Private (uso interno del módulo)
'@ArgumentDescriptions: ruta | Ruta completa a verificar
'@Returns: Boolean | True si es ruta de red
Function IsNetworkPath(ByVal ruta As String) As Boolean
Attribute IsNetworkPath.VB_Description = "[UDFs_FileSystem] Determina si una ruta es de red (UNC o unidad mapeada)"
Attribute IsNetworkPath.VB_ProcData.VB_Invoke_Func = " \n21"
    On Error Resume Next

    IsNetworkPath = False

    ' Normalizar ruta
    If Right(ruta, 1) = "\" Then
        ruta = Left(ruta, Len(ruta) - 1)
    End If

    ' 1. Detectar rutas UNC (\\servidor\compartido)
    If Left(ruta, 2) = "\\" Then
        IsNetworkPath = True
        Exit Function
    End If

    ' 2. Detectar unidades de red mapeadas (Z:, Y:, etc.)
    If Mid(ruta, 2, 1) = ":" Then
        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")

        Dim drive As Object
        Dim driveLetter As String
        driveLetter = Left(ruta, 2)              ' Ej: "C:", "Z:"

        ' Verificar si la unidad existe
        If fso.DriveExists(driveLetter) Then
            Set drive = fso.GetDrive(driveLetter)

            ' DriveType: 0=Unknown, 1=Removable, 2=Fixed, 3=Network, 4=CDRom, 5=RamDisk
            If drive.DriveType = 3 Then          ' 3 = Network
                IsNetworkPath = True
            End If
        End If

        Set drive = Nothing
        Set fso = Nothing
    End If

    On Error GoTo 0
End Function

'@Description: Normaliza una ruta eliminando la barra final
Function NormalizarRuta(ByVal ruta As String) As String
Attribute NormalizarRuta.VB_Description = "[UDFs_FileSystem] Normaliza una ruta eliminando la barra final"
Attribute NormalizarRuta.VB_ProcData.VB_Invoke_Func = " \n21"
    If Right(ruta, 1) = "\" Then
        NormalizarRuta = Left(ruta, Len(ruta) - 1)
    Else
        NormalizarRuta = ruta
    End If
End Function

'@Description: Obtiene el nombre de una carpeta de su ruta completa
Function ObtenerNombreCarpeta(ByVal rutaCompleta As String) As String
Attribute ObtenerNombreCarpeta.VB_Description = "[UDFs_FileSystem] Obtiene el nombre de una carpeta de su ruta completa"
Attribute ObtenerNombreCarpeta.VB_ProcData.VB_Invoke_Func = " \n21"
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    On Error Resume Next
    ObtenerNombreCarpeta = fso.GetFileName(rutaCompleta)
    On Error GoTo 0

    Set fso = Nothing
End Function

Function ObtenerRutaEjecutable(nombreExe As String) As String
Attribute ObtenerRutaEjecutable.VB_Description = "[UDFs_FileSystem] Obtener Ruta Ejecutable (función personalizada)"
Attribute ObtenerRutaEjecutable.VB_ProcData.VB_Invoke_Func = " \n21"
    Dim objShell As Object
    Dim objExec As Object
    Dim comando As String
    Dim resultado As String

    Set objShell = CreateObject("WScript.Shell")

    ' Construye el comando WHERE para el ejecutable indicado
    comando = "cmd.exe /u where " & nombreExe

    ' Ejecuta el comando de forma oculta y captura la salida
    Set objExec = objShell.Exec(comando)
    resultado = objExec.StdOut.ReadAll

    ' Limpiar saltos de línea y devolver solo la primera ruta encontrada
    If resultado <> "" Then
        ObtenerRutaEjecutable = Split(resultado, vbCrLf)(0)
    Else
        ObtenerRutaEjecutable = ""
    End If
End Function