bestandsnaam kopieren

[janemmers]

Graag wil ik bestandnamen van een aantal bestanden kopieren naar excel. Dit zonder extensie. Kan dit? Zo ja, hoe ga ik dan te werk?

 

[enijhuis]

Wat bedoel je precies?
Moeten alleen bestanden uit één folder worden getoond?
Mogen het uitsluitend spreadsheets zijn of ook andere types bestanden?

 

[janemmers]

Ik wil graag een aantal bestandsnamen via mijn verkenner selecteren en kopieren deze vervolgens in een werkblad plakken zonder de extensie. Het gaat me alleen om de bestandsnaam. Het mogen allerlei bestanden zijn bv word.docs excel.xls enz enz. Ze staan op diverse plaatsen op mijn schijf in een map

 

[OctaFish]

Dat vereist nogal wat programmeerwerk, omdat je een keuzelijst moet bouwen waarmee je bestanden selecteert. Zelf heb ik wel zoiets, maar dat wordt gebruikt voor het openen van één bestand, dus dat is niet zo bruikbaar denk ik.

Je kunt met de functie Dir de namen van bestanden opvragen, en in een variabele zetten, of in een cel, of in een document, afhankelijk uiteraard van het programma dat jer ervoor gebruikt. De code ziet er ongeveer als volgt uit:

Dim iCheck As Long

MyPath = "C:\MijnPad\"    ' Set the path.
MyName = Dir(MyPath & "&.xls")   ' Retrieve the first entry.

Do While MyName <> ""    ' Start the loop.
    MyName = Left(MyName, Len(MyName) - 4)
    iCheck = MsgBox(MyName & " invoeren?", vbYesNo, "Naam invoeren") ' Display entry
    If iCheck = vbYes Then MsgBox "OK"
    MyName = Dir    ' Get next entry.
Loop

Hierbij moet je dus zelf het pad opgeven. Je kunt hier wel iets omheenbouwen, zodat je bijvoorbeeld met een Messagebox checkt of een bestand moet worden ingevoerd. Je kunt uiteraard altijd via een inputbox een pad vragen, waarna de procedure de rest voor je oplost.

Heb je in ieder geval een (relatief) simpel begin van een oplossing...

Michel

 

[enijhuis]

Ik zou het zo doen:

Sub ToonBestanden()

    Const ROW_START = 2
    Const COL_START = 3
    
    Dim fdFilePicker As FileDialog
    Dim oFSO As Object
    Dim oSheet As Worksheet
    Dim vntSelectedItem As Variant
    Dim iRow As Integer
    
    On Error GoTo ErrH
    
    Set fdFilePicker = Application.FileDialog(msoFileDialogFilePicker)
    
    With fdFilePicker
        .Filters.Clear
        .Title = "Selecteer bestanden"
        .Filters.Add "Alle bestanden (*.*)", "*.*"
        .AllowMultiSelect = True
        
        'Toon de filepicker
        If .Show Then
        
            'Creëer FileSystemObject
            Set oFSO = CreateObject("Scripting.FileSystemObject")
            Set oSheet = ThisWorkbook.Sheets(1)
            
            'Loop door de geselecteerde bestanden
            For Each vntSelectedItem In .SelectedItems
                
                If oSheet.Cells(ROW_START, COL_START) = vbNullString Then
                    oSheet.Cells(ROW_START, COL_START) = "Bestanden:"
                    
                    oSheet.Cells(ROW_START + 1, COL_START) = oFSO.GetBasename(vntSelectedItem)
                Else
                    iRow = oSheet.Cells(ROW_START, COL_START).End(xlDown).Row + 1
                    oSheet.Cells(iRow, COL_START) = oFSO.GetBasename(vntSelectedItem)
                End If
            Next vntSelectedItem
            
            oSheet.Columns(COL_START).AutoFit
        End If
        
    End With
    
CleanUp:
    'Opruim-acties
    Set oFSO = Nothing
    Exit Sub
ErrH:
    MsgBox Err.Description & vbCr & "(Err.Number: " & Err.Number & ")", vbExclamation
    Resume CleanUp
End Sub

[/CODE]

 

[Roncancio]

Het kan volgens mij wat korter.
Maak bijvoorbeeld gebruik van InStrRev en GetOpenFileName.

Sub Bestandsnaam()
Dim sBestand As String
    sBestand = Application.GetOpenFilename
    Range("A65536").End(xlUp).Offset(1, 0).Value = Mid(sBestand, InStrRev(sBestand, "\") + 1, InStrRev(sBestand, ".") - InStrRev(sBestand, "\") - 1)
End Sub

Bovenstaande code opent een directory.
Als je een keuze maakt en je klikt op Open, wordt het gekozen bestand niet geopend maar verschijnt de naam van het bestand in de A-kolom.

Met vriendelijke groet,


Roncancio

 

[enijhuis]

Inderdaad een stuk korter.
Het is dan alleen niet mogelijk om meerdere bestanden te kiezen in de filepicker.
Ook wordt er een foutmelding getoond wanneer de gebruiker 'Annuleren' kiest in de file open dialoog.

 

[Roncancio]

Zonder foutmelding bij Annuleren:

Sub Bestandsnaam()
Dim sBestand As String
    sBestand = Application.GetOpenFilename
    If sBestand <> "Onwaar" Then Range("A65536").End(xlUp).Offset(1, 0).Value = Mid(sBestand, InStrRev(sBestand, "\") + 1, InStrRev(sBestand, ".") - InStrRev(sBestand, "\") - 1)
End Sub

Met vriendelijke groet,


Roncancio

 

[arend1957]

Het kan volgens mij wat korter.
Maak bijvoorbeeld gebruik van InStrRev en GetOpenFileName.

Sub Bestandsnaam()
Dim sBestand As String
    sBestand = Application.GetOpenFilename
    Range("A65536").End(xlUp).Offset(1, 0).Value = Mid(sBestand, InStrRev(sBestand, "\") + 1, InStrRev(sBestand, ".") - InStrRev(sBestand, "\") - 1)
End Sub

Bovenstaande code opent een directory.
Als je een keuze maakt en je klikt op Open, wordt het gekozen bestand niet geopend maar verschijnt de naam van het bestand in de A-kolom.

Met vriendelijke groet,


Roncancio

hoe krijg ik de extensie erbij?

 

[Roncancio]

hoe krijg ik de extensie erbij?

Het is eigenlijk niet de bedoeling om "in-te-breken" in een topic van iemand anders, maar ik zal toch maar een antwoord geven op je vraag.

Sub Bestandsnaam()
Dim sBestand As String
    sBestand = Application.GetOpenFilename
    If sBestand <> "Onwaar" Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Mid(sBestand, InStrRev(sBestand, "\") + 1)
End Sub

Mocht je nog aanvullende vragen hebben, dan graag een nieuwe topic starten waarin je naar deze topic kunt verwijzen.

Met vriendelijke groet,


Roncancio