Apertura sottocartelle in Excel

Hai un problema con Excel?

Apertura sottocartelle di Enzo

Ciao ragazzi ennesimo problema
in una userform qualcuno sa che comandi impostare per far si di richiamare un certo tipo di percorso
mi spiego meglio
se in una textbox inserisco il nome di un file indipendentemente se questo sara' il nome che voglio salvare o il nome del file che voglio aprire come si puo da un altra textbox
richiamare i percorsi che si hanno sul pc
c:\........ come per esempio quello che appare
in excel con il comando apri dove ti appaiono tutti i percorsi del pc
scusate e' una spiegazione un po contorta ma sono le otto del mattino
grazie anticipatamente per l'aiuto

Ciao enzo di Apoben64

Prova questo codice che avevo in "soffitta", che dovrai adattare al tuo caso specifico. e' comunque una partenza!
ciao luca

Nel modulo dell'userform, incollarci: 
'=============>> 
Private Sub CommandButton1_Click() 
    Dim sParola As String 
    Dim sPercorso As String 


    sParola = Me.TextBox1.Value 
    sPercorso = Me.TextBox2.Value 


    If sParola <> vbNullString _ 
       And sPercorso <> vbNullString Then 
        Call FindWord(sParola, sPercorso) 
    Else 
        MsgBox Prompt:="Non si puo' cercare senza" _ 
                       & " una parola e un percorso!", _ 
               Buttons:=vbCritical, _ 
               Title:="Ricerca Soppressa!" 
    End If 
End Sub 
'<<============= 


In un modulo standard, incollerci il seguente codice: 
'=============>> 
Public Sub FindWord(sWord As String,  _ 
                                          sPath As String) 
    Dim sFile As String 
    Dim arrFiles() As String 
    Dim iCtr As Long 
    Dim i As Long, j As Long 
    Dim srcWB As Workbook 
    Dim destWB As Workbook 
    Dim destSH As Worksheet 
    Dim srcRng As Range 
    Dim destRng As Range 
    Dim arrFound() As String 


    Set destWB = ThisWorkbook 
    Set destSH = destWB.Sheets("Foglio1")   '<<=== da CAMBIARE 
    Set destRng = destSH.Range("A3")           '<<=== da CAMBIARE 


    Range(destRng, destRng.End(xlDown)).ClearContents 


    On Error GoTo XIT: 
    With Application 
        .ScreenUpdating = False 
          .EnableEvents = False 
    End With 


    If Right(sPath, 1) <> "\" Then 
        sPath = sPath & "\" 
    End If 


    sFile = Dir(sPath & "*.xls") 
    If sFile = "" Then 
        MsgBox "Non si trova alcun file XLS " _ 
                         & "nella cartella " & sPath 
        GoTo XIT 
    End If 


    iCtr = 0 
    Do While sFile <> "" 
        iCtr = iCtr + 1 
        ReDim Preserve arrFiles(1 To iCtr) 
        arrFiles(iCtr) = sFile 
        sFile = Dir() 
    Loop 


    If iCtr > 0 Then 
        For iCtr = LBound(arrFiles) To UBound(arrFiles) 
            Application.StatusBar = "CERCANDO IL FILE " _ 
                                        & sPath & arrFiles(iCtr) 
            Set srcWB = Workbooks.Open(sPath & arrFiles(iCtr)) 
            With srcWB 
                For i = 1 To .Worksheets.Count 
                    With .Worksheets(i) 
                      Set srcRng = .Cells.Find(What:=sWord, _ 
                                    After:=.Cells(1), _ 
                                    LookIn:=xlFormulas, _ 
                                    LookAt:=xlPart, _ 
                                    SearchOrder:=xlByColumns, _ 
                                    SearchDirection:=xlNext, _ 
                                    MatchCase:=False) 
                    End With 
                If Not srcRng Is Nothing Then 
                    j = j + 1 
                    ReDim Preserve arrFound(1 To j) 
                    arrFound(j) = .Name 
                    Exit For 
                End If 
                 Next i 
            .Close savechanges:=False 
        End With 
        Next iCtr 
    End If 


    If j > 0 Then 
       destRng.Resize(j).Value = Application.Transpose(arrFound) 
    Else 
        MsgBox Prompt:="La parola " & sWord & " non e' stata trovata!" 
    End If 


XIT: 
    With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
    .StatusBar = False 
    End With 


    Unload UserForm1 
End Sub

di Enzo

Ciao luca e grazie per la tua sollecita risposta ma leggendo bene forse mi sono spiegato male
il mio quesito in parole semplici e' questo
in una userform vorrei attuare quello che si ottiene con il comando apri di excel
ossia clicco su un command button dove mi appaiono i percorsi c:\......(con le sotto cartelle) in una textbox
una volta che ho evidenziato nella textbox il percorso poi questo posso sfruttarlo io succesivamente come voglio ma vorrei che il percorso che si evidenzio in una textbox finisse in un altra textbox
spero forse ora di essere stato chiaro

Ciao enzo di Mauro

Per gestire una finestra simile alla finestra apri è necessario usare
unâ€™api:

codice di richiamo api
dim sfilename as string
dim udtfiledialog as filedialog
dim percorsodaaprire as string

sub apriexpl()

'gestione vecchia
'dim retval
'retval = shell("c:\winnt\explorer.exe", 1) '

with udtfiledialog
.customfilter = "tutti i file (*.*)" & chr$(0) _
& "*.*" & chr$(0) & chr$(0)
.defaultext = "*.*"
.title = "sfoglia"
.initialdir = activeworkbook.path & "\"
end with
percorsodaaprire = winfiledialog(udtfiledialog, 1) if percorsodaaprire <> "" then
if right(percorsodaaprire, 3) = "xls" then
workbooks.open percorsodaaprire
else
call loadmiscfiles
end if
end if

end sub

sub loadfile(filename as string)
shellexecute 0, "open", filename, "", "", 1 end sub

sub loadmiscfiles()
loadfile percorsodaaprire
end sub

in allegato la definizione dell'api da inserire nel progetto, che trovi nella sezione -scambio files-
ciao

di Enzo

Grazie ci provero'

Vuoi approfondire questo argomento?