Ga naar inhoud

Macro zoeken bestand windows map+submappen


Aanbevolen berichten

Hallo Allemaal,

Mijn macro zoekt in een windows map op de volgende manier : "prd." + <cell value> + ".dld"
Het probleem is dat er niet wordt gezocht in inderliggende bmappen

Hier de macro :

Option Explicit

Sub Find_DLD()
Dim AckTime As Integer, InfoBox As Object
Dim iRow As Integer ' ROW COUNTER.
Dim sSourcePath As String, currentpath As String
Dim sDestinationPath As String
Dim sFileType As String
Dim sFileType1 As String

Dim bContinue As Boolean

bContinue = True
iRow = 2

' THE SOURCE AND DESTINATION FOLDER WITH PATH.
sSourcePath = "S:"
sFileType = ".dld" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".
sFileType1 = "prd."


' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
While bContinue

If Len(Range("E" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 1
Select Case InfoBox.Popup("Klaar.", _
AckTime, "Hieperdepiep", 0)
Case 1, -1
Exit Sub
End Select
Else
' CHECK IF FILES EXISTS.

If Len(Dir(sSourcePath & sFileType1 & Range("E" & CStr(iRow)).Value & sFileType)) = 0 Then
Range("F" & CStr(iRow)).Value = "Geen kantprogramma"
Range("F" & CStr(iRow)).Font.Bold = True
Else
Range("F" & CStr(iRow)).Value = "Kantprogramma bestaat!"
Range("F" & CStr(iRow)).Font.Bold = False

End If
End If
iRow = iRow + 1 ' INCREMENT ROW COUNTER.
Wend
End Sub

Het zou fantastisch zijn al iemand deze code zo kan aanpassen dat de macro ook in de onderliggende mappen van s:\ gaat zoeken.

Alvast bedankt voor jullie hulp.

 

Bijlage :  bestand met macro.

Controle dxf + kantprogramma.xlsm

Link naar bericht
Delen op andere sites

Laten we hiermee beginnen.


 

Sub Find_DLD()
Dim AckTime As Integer, InfoBox As Object
Dim iRow As Integer ' ROW COUNTER.
Dim sSourcePath As String
Dim sFileType As String
Dim sFileType1 As String
Dim bContinue As Boolean
Dim found As Boolean, fl As Object, fld As Object

bContinue = True
iRow = 2

' THE SOURCE AND DESTINATION FOLDER WITH PATH.
sSourcePath = "S:"
sFileType = ".dld" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".
sFileType1 = "prd."


' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
While bContinue

    If Len(Range("E" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
        Set InfoBox = CreateObject("WScript.Shell")
        AckTime = 1
        Select Case InfoBox.Popup("Klaar.", AckTime, "Hieperdepiep", 0)
            Case 1, -1
            Exit Sub
        End Select
    Else
        On Error Resume Next
        With CreateObject("scripting.filesystemobject")
            For Each fl In .getfolder(sSourcePath).Files
                If fl.Name Like sFileType1 & Range("E" & CStr(iRow)).Value & sFileType Then found = True: GoTo gevonden
            Next
            For Each fld In .getfolder(sSourcePath).subfolders
                For Each fl In fld.Files
                    If fl.Name Like sFileType1 & Range("E" & CStr(iRow)).Value & sFileType Then found = True: GoTo gevonden
                Next
            Next
        End With
gevonden:
        If Not found Then
            Range("F" & CStr(iRow)).Value = "Geen kantprogramma"
            Range("F" & CStr(iRow)).Font.Bold = True
        Else
            Range("F" & CStr(iRow)).Value = "Kantprogramma bestaat!"
            Range("F" & CStr(iRow)).Font.Bold = False
        End If
    End If
    iRow = iRow + 1 ' INCREMENT ROW COUNTER.
Wend
End Sub

 

Link naar bericht
Delen op andere sites

  • Welkom op PC Helpforum

  • Leden statistieken

    • Aantal leden
      40.073
    • Meeste online
      1.765

    Nieuwste lid
    Raphael Lanneau
    Registratiedatum
  • Gerelateerde inhoud

    • Gast
      Door Gast
      Ik heb gisteren eenn beveiliging van,
      Microsoft Security Essentials gedownload
      en geinst.
      Weet iemand hier iets van.
       
    • Door Joseph Van den Avont
      Ik heb onlangs een pc  via 2dehands.be en heb al meerdere keer met mijn bootable windows usb stick windows te installeren, maar steeds kom ik bij onderstaande scherm terecht bij het instellen van Windows. Dit vraagt om in te loggen met een email van dit bedrijf. Mijn vraag is, hoe kan ik dit omzeilen?
       
      Vriendelijke groeten,
      Joseph

    • Door Rik123
      Beste leden,
       
      Voor mijn werk ben ik een Excel bestand/dashboard aan het maken. Momenteel wordt van alles handmatig een rapportage gemaakt. Omdat ik dacht dit kan handiger ben ik gaan knutselen.
      Ik ben erg ver gekomen en tevreden met mijn resultaat.
       
      Nu kan het altijd beter. Het dashboard werkt namelijk voor een hele maand. In de ideale wereld kan ik zelf een datum invullen en het dashboard laat dan alleen de data zien van die datum. Of nog beter 2 datums en dashboard laat de data tussen deze twee datums zien.
       
      Het gaat in het bestand om de datum in cel A2 >
       
      Ik ben benieuwd of dit mogelijk is of dat er andere suggesties zijn.
      Alvast bedankt voor de moeite!
       
      (PS ik heb het bestand dusdanig aangepast zodat geen privé gegeven erin staan..)
      Voorbeeld bestand voor forumhelp.xlsx
    • Door FrankVG
      Weet iemand hoe in in een vrij grote tekst via 'Zoeken en vervangen' alle regeleinde's kan vervangen door paragraaf-einde's?
       
    • Door Benjaplus
      Hoi hoi,
       
      Ik ben bezig met het opstellen van een factuur in Excel alleen heb ik nog niet al te veel ervaring met Excel en ik kan niks vinden over mijn probleem op internet.
       
      Mijn probleem:
      Ik wil deze zin onderaan mijn factuur: U wordt vriendelijk verzocht het bedrag van (Bedrag uit H36(volledig uitgeschreven in euros)) voor (VANDAAG+14) over te maken op NL00 RABO 0123 4567 89 t.n.v. Naam onder melding van factuurnummer: (nummer uit A14)
       
      Alle ( ) moeten formules worden
       
      Dingen die vet gedrukt zijn moet dat ook zijn in excel
       
      Ik kom zelf tot: ="U wordt vriendelijk verzocht het bedrag van €"&H36&" voor "&VANDAAG()+14&" over te maken naar NL00 RABO 0123 4567 89 t.n.v. Naam onder melding van factuurnummer: "&A14&""
       
      Dan krijg ik: U wordt vriendelijk verzocht het bedrag van €254.1 voor 43775 over te maken naar NL00 RABO 0123 4567 89 t.n.v. Naam onder melding van factuurnummer: 2001
       
      €254.1 moet €254.10 worden (komt door getalnotaties)
      43775 moet 06-11-19 worden (komt door getalnotaties)
      en de andere moet vet gedrukt worden
       
      Het is veel gevraagd, ik weet het, maar ik kom er niet uit. Misschien is het gewoon niet mogelijk, laat het maar weten.
       
      Alvast enorm bedankt!
×
×
  • Nieuwe aanmaken...