Mapnaam en pad in cel

[wiki]

Ik heb onderstaande code voor het selecteren van een map. het lukt mij alleen niet om de uitkomst ervan in een cel te plaatsen. Wie heeft een suggestie, in ben in de weer geweest met cells en Range en value en text

Function GetFolderName(Optional OpenAt As String) As String
    Dim lCount As Long
    
    GetFolderName = vbNullString
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = OpenAt
        .Show
        For lCount = 1 To .SelectedItems.Count
            GetFolderName = .SelectedItems(lCount)
        Next lCount
    End With
End Function
Sub StartAtdesktop()
    MsgBox "You chose" & vbNewLine & GetFolderName("desktop")
End Sub

 

[Thoralf]

Hallo Wiki,

Als je jouw map een keer hebt opgeslagen, dan werkt de volgende formule:

=CEL("bestandsnaam")

Groeten
Thoralf

 

[wiki]

Dat zoek ik niet. Ik wil een map selecteren met de genoemde zoekfunctie en weergeven in een cel. Vanuit deze cel wordt dit pad gebruikt voor een andere routine in het bestand inhoud (zie andere vraag mbt mapinhoud weergeven)
Deze haalt het pad nu uit een tekstveld wat handmatig ingevuld wordt. Door een koppeling te maken tussen deze routine en bovenstaande hoef ik het pad niet buiten excel op te zoeken.

Sub Recurse()

Dim sDirname As String

sDirname = shList.tbDirectory.Text

If Right(sDirname, 1) = "\" Then sDirname = Left(sDirname, Len(sDirname) - 1)

Application.ScreenUpdating = False

'Read the level of start folder
iStartDepth = CharCount(CStr(sDirname), "\")

'Reset the formatting
Columns("B:B").Select
Selection.Font.Bold = False
Selection.Font.Bold = True

Cells.Select
Selection.ClearContents
Selection.Hyperlinks.Delete
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = 0
Selection.EntireRow.Hidden = False
Call UngroupRows


Range("a1").Select

RowIndex = 1
Call RecurseFolderList(sDirname & "\")

Call GroupRows

Range("a1").Select

Application.ScreenUpdating = True

MsgBox "Created a structure of " & RowIndex - 1 & " folders and files over " & iMaxDepth & " levels"


End

End Sub

 

[snb]

Als jouw code doet wat ie moet doen:

Sub StartAtdesktop()
activesheet.cells(1,1)= GetFolderName("desktop")
End Sub


Ik snap in de funktie de loop niet, omdat dan steeds de variabele overschreven wordt.
En het tegelijkertijd selecteren van diverse mappen lijkt me ook al niet voor de hand liggend.

Function GetFolderName(Optional OpenAt As String) As String 
  Dim lCount As Long 
  GetFolderName = vbNullString 
     
  With Application.FileDialog(msoFileDialogFolderPicker) 
    .InitialFileName = OpenAt 
    .Show 
[COLOR="Teal"]    For lCount = 1 To .SelectedItems.Count 
          GetFolderName = .SelectedItems(lCount) 
      Next lCount [/COLOR]
  End With 
End Function

 

[wiki]

Gelukt

Pad is nu te selecteren door in te voeren of te browsen

 

[snb]

Voor een simpeler methode om de mapstruktuur uit te lezen zie de bijlage.