Zoeken in meerdere (sub)directories

[royb73]

Beste heren,

Ik hier een code die alleen in 1 map zoekt ("C:\Temp"). De zoekwaarden zijn rapportnummers in kolom 1 en vanaf rij 3. Indien ik op een cel sta met een rapportnummer, dan zoekt de code de desbetreffende dir erbij in de aangegeven map. Vervolgens opent de code de desbetreffende directory.

Sub ZoekMap()
    Dim Folder As String
    Dim TopDir As String
    
    
    On Local Error GoTo Stoppen
    If ActiveCell.Column = 1 And ActiveCell.row > 3 And ActiveCell.Value <> "" Then
        TopDir = "C:\Temp\"
        Folder = Dir(TopDir & "*" & ActiveCell.Value & "*", vbDirectory)
        If Folder <> "" Then
            Folder = TopDir & Folder & "\"
            Shell Environ("WINDIR") & "\explorer.exe """ & Folder & "", vbNormalFocus
        Else
            MsgBox "Geen bijbehorende map gevonden."
        End If
    End If
        
Stoppen:
End Sub

Vraag:
1. Hoe kan ik tegelijk zoeken in meerdere (sub)directories? Nu zoekt het alleen in "C:\Temp", maar zou ook willen zoeken in de submappen van C:\Temp\. Tevens wil ik ook zoeken in "C:\Rapport", "W:\Testrapport\2011" etc.
2. Hoe kan de code If ActiveCell.Column = 1 And ActiveCell.row > 3 And ActiveCell.Value <> "" Then" aangepast worden, indien ik niet in column 1 zoekt, dat ik een melding krijg dat ik niet in kolom 1 zoek. Als ik bijvoorbeeld in kolom 2 zoek en de code run, dan doet het niks en zou fijn zijn dat ik een melding krijg.

Alvast bedankt.

Met vriendelijke groet,

Roy

 

[snb]

Wat levert het wijzigen van de directory op ?

 

[royb73]

Er staan rapporten in verschillende directory's.
Daarom wil ik al die paden, waar de rapporten bevinden, toevoegen in de code zodat de code al die mappen naloopt en de desbetreffende map opent.

Mvg
Roy

 

[snb]

Ik vergat je erop te wijzen dat in dit forum niet alleen maar heren opereren.

Dan is het toch veel zinvoller de bestanden die gevonden zouden moeten/kunnen worden in 1 directory te zetten. Dat bespaart je code, tijd en vergissingen.

 

[OctaFish]

Je kunt er een array op los laten:

    arr = Array("C:\Temp\", "C:\Rapport", "W:\Testrapport\2011")
    If ActiveCell.Row > 3 And ActiveCell.Value <> "" Then
        TopDir = arr(i)
        On Local Error GoTo Stoppen
        For i = LBound(arr) To UBound(arr)
            Folder = Dir(TopDir & ActiveCell.Value & "*", vbDirectory)
            If Folder <> "" Then
                Folder = TopDir & Folder & "\"
                Shell Environ("WINDIR") & "\explorer.exe """ & Folder & "", vbNormalFocus
            Else
                MsgBox "Geen bijbehorende map gevonden."
            End If
        Next i
    End If

 

[royb73]

Excuses, had ook dames erbij moeten zetten.
Het probleem is, dat de rapporten destijds (vanaf 1998) overal is opgeslagen (zowel lokaal als op het netwerk). Het is een karwei om die bestanden op 1 centrale plek te krijgen omdat er links (bij bepaalde afdelingen) zijn die naar de paden wijzen.

 

[royb73]

Met Array lukt het niet. Indien ik daar alleen 1 padnaam zet, dan pakt hij het wel.


Mvg

Roy

 

[OctaFish]

Heb je de variabele wel goed gedeclareerd?

 

[snb]

zo krijg je alle rapporten op de C-schijf.

Die kun je vervolgens naar eenzelfde directory verplaatsen

sub M_snb()
  sn=filter(split(createobject("wscript.shell").exec("cmd /c dir ""C:\*rapport.*"" /b /s /a-d").stdout.readall,vbcrlf),".")
 
  for eacht it in sn
    name it as G:\OF\" & dir(it)
  next
End Sub

 

[royb73]

Beste snb,

Kopieert hij de rapporten van de desbetreffende locaties of verplaats hij de rapporten?

Groeten,

Roy

 

[royb73]

Beste OctaFish,

Helaas is het gelukt. Weet niet wat ik fout doe.

Mvg

Roy.

 

[snb]

De code verplaatst de rapporten; maar dat je bij het testen natuurlijk al uitgevonden.

 

[royb73]

Ik heb het nog niet gedaan, omdat er verschillende afdelingen de rapporten benaderen. Daarom dacht ik om het even te vragen voordat er allerlei collega's bij mijn bureau komen

 

[royb73]

Ik heb het even zo opgelost, maar ik krijg nu bij elke folder de melding dat de bijbehorende niet gevonden is en de folder in kwestie wordt geopend.

Hoe kan ik deze padnamen samenvoegen (Array?)? Hoe krijg ik 1x de melding als het rapport helemaal niet bestaat in de desbetreffende folders? Hoe kan voorkomen worden dat ik geen melding krijg indien de folder wel bestaat in 1 van de folders?

Sub ZoekMap()
    Dim Folder As String
    Dim Folder2 As String
    Dim TopDir As String
    Dim TopDir2 As String
     
    On Local Error GoTo Stoppen
    If ActiveCell.Column = 1 And ActiveCell.row > 3 And ActiveCell.Value <> "" Then
        TopDir = "C:\Temp\"
        Folder = Dir(TopDir & "*" & ActiveCell.Value & "*", vbDirectory)
        If Folder <> "" Then
            Folder = TopDir & Folder & "\"
            Shell Environ("WINDIR") & "\explorer.exe """ & Folder & "", vbNormalFocus
        Else
            MsgBox "Geen bijbehorende map gevonden."
        End If
    End If
    
    On Local Error GoTo Stoppen
    If ActiveCell.Column = 1 And ActiveCell.row > 3 And ActiveCell.Value <> "" Then
        TopDir2 = "D:\Temp\"
        Folder2 = Dir(TopDir2 & "*" & ActiveCell.Value & "*", vbDirectory)
        If Folder2 <> "" Then
            Folder2 = TopDir2 & Folder2 & "\"
            Shell Environ("WINDIR") & "\explorer.exe """ & Folder2 & "", vbNormalFocus
        Else
            MsgBox "Geen bijbehorende map gevonden."
        End If
    End If
            
Stoppen:
End Sub