Problemas con el Drive
Hola germansalvia, gracias de antemano.
mi problema es el siguiente: en un formulario tengo un control DriveListBox y un DirListBox donde visualizar las carpetas de las unidades que elijo. Resulta que si no inserto un disquete o cd en sus unidades correspondientes y selecciono la opcion de sus unidades correspondientes se genera un error que no es posible superar con el On Error GoTO ...
Me gustaria si es posible, algun codigo que me supere esta dificultad. Gracias
mi problema es el siguiente: en un formulario tengo un control DriveListBox y un DirListBox donde visualizar las carpetas de las unidades que elijo. Resulta que si no inserto un disquete o cd en sus unidades correspondientes y selecciono la opcion de sus unidades correspondientes se genera un error que no es posible superar con el On Error GoTO ...
Me gustaria si es posible, algun codigo que me supere esta dificultad. Gracias
1 respuesta
Respuesta de germansalvia
1
El error es trapeable, es el nro 68, te paso un ejemplo:
Private Sub Drive1_Change()
On Error GoTo Herror
Dir1.Path = Drive1.Drive
Exit Sub
Herror:
If Err.Number = 68 Then
MsgBox "no hay dispositivo"
End If
End Sub
Te paso tambien un ejemplo mejor de como seleccionar carpetas tipo explorer
En un formulario pones un botomn con :
Private Sub Command1_Click()
Label1.Caption = GetFolder("Seleccione un directorio:")
End Sub
Y en el modulo pones:
Option Explicit
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Function GetFolder(Titulo As String) As String
Dim bInf As BROWSEINFO
Dim RetVal As Long
Dim PathID As Long
Dim RetPath As String
Dim Offset As Integer
'Establece las propiedades del dialogo
bInf.hOwner = Form1.hWnd
bInf.lpszTitle = Titulo
bInf.ulFlags = BIF_RETURNONLYFSDIRS
'Muestra el cuadro de dialogo del browse
PathID = SHBrowseForFolder(bInf)
RetPath = Space$(512)
RetVal = SHGetPathFromIDList(ByVal PathID, ByVal RetPath)
If RetVal Then
Offset = InStr(RetPath, Chr$(0))
GetFolder = Left$(RetPath, Offset - 1)
CoTaskMemFree PathID
Else
GetFolder = ""
End If
End Function
Private Sub Drive1_Change()
On Error GoTo Herror
Dir1.Path = Drive1.Drive
Exit Sub
Herror:
If Err.Number = 68 Then
MsgBox "no hay dispositivo"
End If
End Sub
Te paso tambien un ejemplo mejor de como seleccionar carpetas tipo explorer
En un formulario pones un botomn con :
Private Sub Command1_Click()
Label1.Caption = GetFolder("Seleccione un directorio:")
End Sub
Y en el modulo pones:
Option Explicit
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Function GetFolder(Titulo As String) As String
Dim bInf As BROWSEINFO
Dim RetVal As Long
Dim PathID As Long
Dim RetPath As String
Dim Offset As Integer
'Establece las propiedades del dialogo
bInf.hOwner = Form1.hWnd
bInf.lpszTitle = Titulo
bInf.ulFlags = BIF_RETURNONLYFSDIRS
'Muestra el cuadro de dialogo del browse
PathID = SHBrowseForFolder(bInf)
RetPath = Space$(512)
RetVal = SHGetPathFromIDList(ByVal PathID, ByVal RetPath)
If RetVal Then
Offset = InStr(RetPath, Chr$(0))
GetFolder = Left$(RetPath, Offset - 1)
CoTaskMemFree PathID
Else
GetFolder = ""
End If
End Function
