Private Sub Form_Load()
Dim Ocultos As String
Ocultos = Dir("c:\", vbDirectory + vbHidden)
Do While Ocultos <> ""
Debug.Print Ocultos
Ocultos = Dir
Loop
End Sub

Option Explicit

Private Const MAX_PATH = 260
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Const LB_GETCOUNT = &H18B
Private Const LB_INSERTSTRING = &H181
Private Const LB_ERR = (-1)


Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10


Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByVal lParam As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long


Private Sub ShowHiddenDirectories(DirCtrl As DirListBox, Optional bShowSystem As Boolean)
    Dim res As Long
    Dim sF As String, sDirPath
    Dim FData As WIN32_FIND_DATA
    Dim fHand As Long, i As Long
    Dim level As Long
    Dim StillOK As Long
    Const HIDDEN_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_HIDDEN
    sDirPath = DirCtrl.Path
    If Right$(sDirPath, 1) <> "\" Then sDirPath = sDirPath & "\"
    res = SendMessage(DirCtrl.hwnd, LB_GETCOUNT, 0, 0)
    If res = LB_ERR Then Exit Sub
    level = res - DirCtrl.ListCount
    fHand = FindFirstFile(sDirPath & "*", FData)
    StillOK = fHand
    Do While StillOK > 0
        If (FData.dwFileAttributes And HIDDEN_DIRECTORY) >= HIDDEN_DIRECTORY Then
           If bShowSystem Or ((FData.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) = 0) Then
            sF = CutRightAt(FData.cFileName)
            If sF <> "." And sF <> ".." Then
                i = DirCtrl.ListCount
                Do
                    If i > 0 Then
                        res = StrComp(sF, Right(DirCtrl.List(i - 1), Len(DirCtrl.List(i - 1)) - Len(sDirPath)), vbTextCompare)
                        If res >= 0 Then
                            If res Then res = SendMessageString(DirCtrl.hwnd, LB_INSERTSTRING, i + level, sF)
                            Exit Do
                       
                        End If
                    Else
                        If i = 0 Then res = SendMessageString(DirCtrl.hwnd, LB_INSERTSTRING, i + level, sF)
                    End If
                    i = i - 1
                Loop While i >= 0
            End If
           End If
        End If

        StillOK = FindNextFile(fHand, FData)
    Loop

    fHand = FindClose(fHand)
End Sub

Private Function CutRightAt(NormString As String, Optional ascii As Long = 0) As String
    Dim i As Long
    i = InStr(1, NormString, Chr(ascii), vbBinaryCompare)
    If i Then
        CutRightAt = Left(NormString, i - 1)
    Else
        CutRightAt = NormString
    End If
End Function

Private Sub Dir1_Change()
    ShowHiddenDirectories Dir1, True
End Sub

regsvr nombredelcontrol.ocx