syed_iqbal
02-12-2017, 05:02 AM
Hi,
On my desktop there is one folder (lets say) "Test". in that there are 10 files and those names are aaa,bbb,ccc,ddd,eee,fff,... so on. and in my worksheet there are 15 employee names (aaa,bbb,ccc,ddd,eee,fff,...) (from cell E2:E16). if we run vba code, all file paths should match with employee names like below
employee name file path
aaa C:\desktop\test\aaa.xlsx
bbb C:\desktop\test\bbb.xlsm
ccc C:\desktop\test\ccc.csv
ddd C:\desktop\test\ddd.xls
. .
. .
. .
. .
Thank you advance for your help.
regards
syed
Kenneth Hobs
02-12-2017, 10:02 AM
Sub Main()
Dim p$, fso As Object, r As Range, i&, f As Range, a
Set fso = CreateObject("Scripting.FileSystemObject")
p = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Test\"
With fso
If Not .FolderExists(p) Then
MsgBox p & vbLf & "does not exist.", vbCritical, "Macro Ending"
Exit Sub
End If
Set r = Range("E2", Cells(Rows.Count, "E").End(xlUp))
a = aFFs(p, "/A-D")
For i = 0 To UBound(a)
Set f = r.Find(.GetBaseName(a(i)), Lookat:=xlWhole)
If Not f Is Nothing Then f.Offset(, 1).Value2 = a(i)
Next i
End With
r.Offset(, 1).EntireColumn.AutoFit
End Sub
'Set extraSwitches, e.g. "/ad", to search folders only.
'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
Optional tfSubFolders As Boolean = False) As Variant
Dim s As String, a() As String, v As Variant
Dim b() As Variant, i As Long
If tfSubFolders Then
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
Else
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
End If
a() = Split(s, vbCrLf)
If UBound(a) = -1 Then
Debug.Print myDir & " not found, aFFs() ending"
Exit Function
End If
ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
For i = 0 To UBound(a)
If Not tfSubFolders Then
s = Left$(myDir, InStrRev(myDir, "\"))
'add the folder name
a(i) = s & a(i)
End If
Next i
aFFs = sA1dtovA1d(a)
End Function
Function sA1dtovA1d(strArray() As String) As Variant
Dim varArray() As Variant, i As Long
ReDim varArray(LBound(strArray) To UBound(strArray))
For i = LBound(strArray) To UBound(strArray)
varArray(i) = CVar(strArray(i))
Next i
sA1dtovA1d = varArray()
End Function
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.