asked on
Sub GetFullPath()
'the best one
Dim lngRow As Long
Dim lngLastRow As Long
Dim strFile As String
Dim strRoot As String
Dim strCurrPath As String
Application.ScreenUpdating = False
With ThisWorkbook.ActiveSheet
lngLastRow = .Range("A1048576").End(xlUp).Row
strRoot = "G:\KLS_Allgemein\DMD\"
' Collect the subdirectories of the root
strCurrPath = Dir(strRoot, vbDirectory)
Do Until strCurrPath = vbNullString
If Left(strCurrPath, 1) <> "." And _
(GetAttr(strRoot & strCurrPath) And vbDirectory) = vbDirectory Then
mcolDirectories.Add strCurrPath
End If
strCurrPath = Dir()
Loop
For lngRow = 2 To lngLastRow
strFile = LoopThroughFiles(strRoot, .Cells(lngRow, "A"))
If Len(strFile) > 0 Then
.Cells(lngRow, "B") = strFile
Else
.Cells(lngRow, "B") = "Not found"
End If
Next
End With
Application.ScreenUpdating = True
End Sub