Apertura sottocartelle in 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'