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.
Macro zoeken bestand windows map+submappen
in Archief Excel
Geplaatst:
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