Avatar billede Slettet bruger
16. januar 2015 - 11:01 Der er 2 kommentarer og
1 løsning

Hente submappenavn til excel regneark

Hej alle eksperter

Jeg skal hente mappenavne fra mine eksterne harddiske, og liste dem i et excelark og har fundet en makro på spørgsmålet http://www.eksperten.dk/spm/908738, og den virker faktisk perfekt, men ikke til mit brug. Den skal kun hente mappenavne ikke submapper eller filer. Kan nedenstående makro rettes til eller hvad kan jeg evt gøre?

Mvh. rwj

Rem Koden anbringes under Ark1 (højreklik på arkfanen - Vis programkode)
Rem Overskrift i række 1
Rem Makroen kan kaldes fra regnearket med Alt+F8 - afspil "OpretFilOversigt"
Rem Udpeg mappen - klik neutralt sted heri - tryk annuller - så bliver alle filer behandlet
Rem Efter kørslen - gem regnearket og kald makroen & udpeg næste mappe.
Rem Mit regneark kan i givet fald fremsendes - hvis du sender en mail - @-adr. under min profil
rem ===========================================

Dim sidsteRække As Long, aktuelleMappe As String
Dim filNavn As String, filStørrelse As Long, filType As String, sidstÆndret As Date
Dim ræk As Long, række As String
Sub opretFilOversigt()
sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
udpegMappe

ræk = sidsteRække + 1
gennemløbAfAktuelleMappe

End Sub
Private Sub udpegMappe()
With Application.FileDialog(msoFileDialogOpen)
.Show
End With
aktuelleMappe = CurDir

End Sub
Private Sub gennemløbAfAktuelleMappe()
Dim fs, f, fil, fc

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(aktuelleMappe)
Set fc = f.Files

Application.ScreenUpdating = False
For Each fil In fc
With fil
filNavn = .Name
filStørrelse = .Size
filType = .Type
sidstÆndret = Format(.DateLastModified, "dd-mm-yy")
End With
Avatar billede KurtOA Praktikant
17. januar 2015 - 11:15 #1
Hej.

Har ændret lidt i din kode således at den viser mapper istedet for filer.

mvh

Rem Koden anbringes under Ark1 (højreklik på arkfanen - Vis programkode)
Rem Overskrift i række 1
Rem Makroen kan kaldes fra regnearket med Alt+F8 - afspil "OpretFilOversigt"
Rem Udpeg mappen - klik neutralt sted heri - tryk annuller - så bliver alle filer behandlet
Rem Efter kørslen - gem regnearket og kald makroen & udpeg næste mappe.
Rem Mit regneark kan i givet fald fremsendes - hvis du sender en mail - @-adr. under min profil
Rem ===========================================

Dim sidsteRække As Long, aktuelleMappe As String
Dim filNavn As String, filStørrelse As Long, filType As String, sidstÆndret As Date
Dim ræk As Long, række As String
Sub opretFilOversigt()
    sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
    udpegMappe
   
    ræk = sidsteRække + 1
    gennemløbAfAktuelleMappe
   
End Sub
Private Sub udpegMappe()

With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .Show
  On Error Resume Next
  aktuelleMappe = .SelectedItems(1)
  Err.Clear
  On Error GoTo 0
End With

   
End Sub
Private Sub gennemløbAfAktuelleMappe()
Dim mappe, fs, f, fm, fil, fc

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(aktuelleMappe)
    Set fm = f.subFolders
   
    On Error Resume Next
   
    Application.ScreenUpdating = False
    For Each mappe In fm
       
        række = ræk
        Range("A" & række) = mappe
        Range("B" & række) = mappe.Size
        Range("C" & række) = mappe.Type
       
        ræk = ræk + 1
    Next
   
    Columns.AutoFit
   
    Application.ScreenUpdating = True
End Sub
Avatar billede Slettet bruger
17. januar 2015 - 12:50 #2
Hej KurtOA

Det er super, jeg har netop testet den redigerede kode og den virker helt efter mine ønsker.

Tak for hjælpen, god weekend og smid et svar, så du kan få dine point:-)

mvh. rwj
Avatar billede KurtOA Praktikant
17. januar 2015 - 13:17 #3
Ok et svar ;-)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester