Avatar billede mrkr Juniormester
25. juli 2016 - 13:53 Der er 9 kommentarer og
2 løsninger

VBA som finder alle filer i mapper og undermapper

Jeg har en masse filer med samme navn, men som ligger i en masse undermapper som jeg gerne vil have ændret en tekst i.

Faktisk skal den slette indhold i E10 og skrive "JA" i E11 i arket "Relevans"
Kan man få vba til at rende mapperne igennem og søge efter et bestemt filnavn og så gøre ovenstående?

Hvis der kan komme en popup pr. fil den finder hvor man kan vælge ja/nej, vil det være super godt.
Avatar billede supertekst Ekspert
25. juli 2016 - 14:12 #1
Ja det er muligt
Vender tilbage ...
Avatar billede supertekst Ekspert
25. juli 2016 - 15:18 #2
Indsættes i Excel-fil

Const filNavn = "Fil1.xlsx"                'JUSTERES
Const startMappe = "D:\MinMappe"            'JUSTERES
Sub søgEfterFil()
    traverserDrev startMappe
End Sub
Private Sub traverserDrev(mappenavn)
    Dim fs, f, f1, fc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappenavn)
    Set fc = f.SubFolders
   
    For Each f1 In fc
        findFiler f1.Path
        traverserDrev f1
    Next
End Sub
Private Sub findFiler(mappesti)
Dim fs, f, f1, fc, fNavn As String, svar As Integer

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappesti)
    Set fc = f.Files
   
    For Each f1 In fc
Rem hvis søgte navn - spørg om justeres
        If LCase(f1.Name) = LCase(filNavn) Then
            svar = MsgBox("Skal fil justeres?", vbYesNo, mappesti & "\" & f1.Name)
            If svar = 6 Then
                Workbooks.Open mappesti & "\" & filNavn
                ActiveWorkbook.Sheets("Relevans").Activate
                ActiveSheet.Range("E10") = ""
                ActiveSheet.Range("E11") = "JA"
                ActiveWorkbook.Save
            End If
        End If
    Next
End Sub
Avatar billede mrkr Juniormester
25. juli 2016 - 15:58 #3
Ja, for pokker.
Den gør lige det jeg tænkte og så slipper jeg for at sidde og lede efter de enkelte filer.
Mange for hjælpen :-)
Avatar billede mrkr Juniormester
25. juli 2016 - 16:13 #4
Nu har jeg siddet og kørt nogle filer igennem og det virker super.
Kunne man udvide koden med at den i "kildefilen" noterer de filer den har rettet.

Jeg tænker at den i arket "ListeMedFiler" indsætter filnavnene i celle A1, A2, A3 osv.
Det vil være super at have dette til overblikket når man har rendt filerne igennem.
Avatar billede supertekst Ekspert
25. juli 2016 - 16:57 #5
Selv tak

Kildelfilen er altså filen med VBA koden
Arket du nævner kunne vel være Ark1 - omdøbt
Går ud fra at hele stien skal med
Det skulle ikke være noget problem.

Der skal vel tages højde for flere kørsler eller ?
Så der ikke overskrives i arket ListeMedFiler
Avatar billede mrkr Juniormester
25. juli 2016 - 17:47 #6
Jeps kildefilen er den med koden.
Jeps det kunne være ark1 som er omdøbt
Jeps hele stien skulle gerne med incl. filnavnet.
Den må meget gerne tage højde for flere kørsler, så den "bygger videre" på listen.
Avatar billede supertekst Ekspert
25. juli 2016 - 18:11 #7
Ok - fortsætter på VBA-koden iflg. #6 - vel nok i morgen
Avatar billede mrkr Juniormester
25. juli 2016 - 18:12 #8
Super :-)
Avatar billede supertekst Ekspert
25. juli 2016 - 23:45 #9
Rem Version 2
Rem =========
Const filNavn = "Fil1.xlsx"                'JUSTERES
Const startMappe = "D:\MinMappe"            'JUSTERES
Const arkListeMedFiler = "ListeMedFiler"    'Kan justeres

Dim system As Object, antalRækker As Integer                  '1. ledige række på arket "ListeMedFiler"
Sub søgEfterFil()
    Set system = ActiveWorkbook
    antalRækker = findFørsteRække + 1
    traverserDrev startMappe
End Sub
Private Function findFørsteRække()
    With system.Sheets(arkListeMedFiler)
        findFørsteRække = ActiveCell.SpecialCells(xlLastCell).Row
    End With
End Function
Private Sub traverserDrev(mappenavn)
    Dim fs, f, f1, fc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappenavn)
    Set fc = f.SubFolders
   
    For Each f1 In fc
        findFiler f1.Path
        traverserDrev f1
    Next
End Sub
Private Sub findFiler(mappesti)
Dim fs, f, f1, fc, fNavn As String, svar As Integer

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappesti)
    Set fc = f.Files
   
    For Each f1 In fc
Rem hvis søgte navn - spørg om justeres
        If LCase(f1.Name) = LCase(filNavn) Then
            svar = MsgBox("Skal fil justeres?", vbYesNo, mappesti & "\" & f1.Name)
            If svar = 6 Then
                Workbooks.Open mappesti & "\" & filNavn
                ActiveWorkbook.Sheets("Relevans").Activate
                ActiveSheet.Range("E10") = ""
                ActiveSheet.Range("E11") = "JA"
                ActiveWorkbook.Save
                ActiveWorkbook.Close
               
                opdaterListeMedFiler mappesti & "\" & f1.Name
            End If
        End If
    Next
End Sub
Private Sub opdaterListeMedFiler(sti)
    With system.Sheets(arkListeMedFiler)
        .Range("A" & antalRækker) = sti
        antalRækker = antalRækker + 1
    End With
End Sub
Avatar billede mrkr Juniormester
26. juli 2016 - 10:34 #10
Så fik jeg mulighed for at teste.
Det er super godt.
Så har jeg et godt overblik over hvilke mapper / filer der er rettet.

Endnu engang mange tak for hjælpen :-)
Avatar billede supertekst Ekspert
26. juli 2016 - 11:15 #11
selv tak - en fornøjelse..
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

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