Recursive Search Through Subfolders BACK to Root Directory - excel

I have a function that works to search through the subfolders of a given directory and finds the file name I need. However, it only goes through one set of subfolders, finding the first one and then going through to the end of the subfolders. However, it then just stops. I have looked through various threads and tried different options but no joy.
I need it to then loop back to the root directory (say, sPath=C:\Windows) and look at the next subfolder, go through that whole directory, come back to the root folder, and so on until it finds the file it needs. I cannot seem to get that part to work, hoping someone here can help point out what I am missing. I am trying to keep this set at a higher level root folder rather than have to start lower in in the directory to get it to work. Here is the function:
Function recurse(sPath As String, strname As String, strName3 As String)
Dim FSO As New FileSystemObject
Dim myFolder As Scripting.Folder
Dim mySubFolder As Scripting.Folder
Dim myFile As Scripting.file
Dim strJDFile As String
Dim strDir As String
Dim strJDName As String
Set myFolder = FSO.GetFolder(sPath)
' strName = Range("a2").Offset(0, 3)
strName3 = Replace(strName3, "/", " ")
For Each mySubFolder In myFolder.SubFolders
Debug.Print " mySubFolder: " & mySubFolder
For Each myFile In mySubFolder.Files
If "*" & myFile.Name & "*" Like "*" & strName3 & "*" Then
strJDName = myFile.Name
strDir = mySubFolder & "\"
strJDFile = strDir & strJDName
recurse = strJDFile
Exit Function
Else
Debug.Print " myFile.name: " & myFile.Name
End If
Next
recurse = recurse(mySubFolder.Path, strname, strName3)
Next
End Function

Here is a routine you may be able to adapt to your use, if you are running Excel under Windows.
Pick a base folder using the Excel folder picker routine
Enter a file name mask (eg: Book1.xls*)
Uses the Dir command window command to check all the folders and subfolders for files that start with Book1.xls
The results of the command are written to a temporary file (which is deleted at the end of the macro)
There is a way to write it directly to a VBA variable, but I see too much screen flicker when I've done that.
The results are then collected into a vba array, and written to a worksheet, but you can do whatever you want with the results.
Option Explicit
'set references to
' Microsoft Scripting Runtime
' Windows Script Host Object model
Sub FindFile()
Dim WSH As WshShell, lErrCode As Long
Dim FSO As FileSystemObject, TS As TextStream
Dim sTemp As String
Dim sBasePath As String
Dim vFiles As Variant, vFullList() As String
Dim I As Long
Dim sFileName As String
sTemp = Environ("Temp") & "\FileList.txt"
'Select base folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then 'if OK is pressed
sBasePath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'File name mask
sFileName = InputBox("Entire File Mask", "File Finder")
Set WSH = New WshShell
lErrCode = WSH.Run("CMD /c dir """ & sBasePath & "\*" & sFileName & """ /A-D /B /S > " & sTemp, xlHidden, True)
If Not lErrCode = 0 Then
MsgBox "Problem Reading Directory" & _
vbLf & "Error Code " & lErrCode
Exit Sub
End If
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(sTemp, ForReading, False, TristateFalse)
vFiles = Split(TS.ReadAll, vbLf)
TS.Close
FSO.DeleteFile sTemp
Set FSO = Nothing
Set WSH = Nothing
ReDim vFullList(1 To UBound(vFiles), 1 To 1)
For I = 1 To UBound(vFiles)
vFullList(I, 1) = vFiles(I)
Next I
Dim rDest As Range
Set rDest = Cells(1, 2).Resize(UBound(vFullList, 1), UBound(vFullList, 2))
With rDest
.EntireColumn.Clear
.Value = vFullList
.EntireColumn.AutoFit
End With
End Sub

Related

i need to find the last saved file in a Folder and move(or copy) it to an other folder, using VBA. Can anybody help me put with that?

I need to look in a specific folder and find the last file saved and move(or copy) to an other folder using VBA.
by finding the file i'm using:
Private Function fFindLastFile()
'Call GetFolder
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim myFolder As Object
Set myFolder = fso.GetFolder("D:\SF\C0T460A220000042\")
'Set myFolder = fso.GetFolder(GetFolder)
Dim myFile As Object
Set myFile = myFolder.Files.Item(myFolder.Files.Count) '<----- this is where i get a debug nr 5, unknown procedure or argument
MsgBox myFile.Name & " was last modified on " & myFile.DateLastModified
End Function
I don not have the name or type of the file that i'm looking for, but i just downloaded it from a known URL.
do you have any ideas what i'm doing wrong?
Last Modified File (FileSystemObject)
Option Explicit
Private Sub CopyLastFile()
Const sFolderPath As String = "D:\SF\C0T460A220000042\"
Const dFolderPath As String = "C:\Test\" ' adjust!
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim fsoFolder As Object: Set fsoFolder = fso.GetFolder(sFolderPath)
Dim fsoFile As Object, fName As String, fDate As Date
For Each fsoFile In fsoFolder.Files
If fsoFile.DateLastModified > fDate Then
fName = fsoFile.Name
fDate = fsoFile.DateLastModified
End If
Next fsoFile
If Len(fName) > 0 Then
fso.CopyFile sFolderPath & fName, dFolderPath, True
'fso.MoveFile sFolderPath & fName, dFolderPath, True
MsgBox "File Name: " & fName & vbLf & "Last modified: " & fDate, _
vbInformation, "Last Modified File"
Else
MsgBox "No file found.", vbExclamation, "Last Modified File"
End If
End Sub

Select a previous file in a folder and copy it to a new one

I need to do the following:
Allow the user to select any number of files, in any format, and copy them to a new folder.
Create the destination folder if it doesn't exist. In this case, the folder name should be given by the content of the C2 & C3 cells (Range("C2").Value & Range("C3").Text & "\").
Private Sub CommandButton4_Click()
Dim strDirname As String
Dim strDefpath As String
Dim strPathname As String
Dim strFilename As String
Dim FSO
Dim sFile As FileDialog
Dim sSFolder As String
Dim sDFolder As String
strDirname = Range("C2").Value & Range("C3").Text
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename
Set sFile = Application.FileDialog(msoFileDialogOpen)
sDFolder = strDirname & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO = New FileSystemObject
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
If Not .Show Then Exit Sub
Set xFolder = FSO.GetFolder(.SelectedItems(1))
For Each xFile In xFolder.Files
On Error Resume Next
xRow = Application.Match(xFile.Name, Range("A:A"), 0)
On Error GoTo 0
Next
End With
End Sub
I know the error is here...
Set xFolder = FSO.GetFolder(.SelectedItems(1))
...because I'm asking it to get a file, not a folder.
It is not very clear to me what you are trying to do but, if you intend to select a folder, you have to use it
Application.FileDialog (msoFileDialogFolderPicker)
instead of
Application.FileDialog (msoFileDialogFilePicker)
Your posted code shows so little resemblance to what you Q asks for, I've disregarded it.
This code follows the description. You may need to alter certain details to fully match your needs
Sub Demo()
Dim FilePicker As FileDialog
Dim DefaultPath As String
Dim DestinationFolderName As String
Dim SelectedFile As Variant
Dim DestinationFolder As Folder
Dim FSO As FileSystemObject
DefaultPath = "C:\Data" ' <~~ update to suit, or get it from somewhere else
' Validate Default Path
If Right$(DefaultPath, 1) <> Application.PathSeparator Then
DefaultPath = DefaultPath & Application.PathSeparator
End If
If Not FSO.FolderExists(DefaultPath) Then Exit Sub
' Get Destination Folder, add trailing \ if required
DestinationFolderName = Range("C2").Value & Range("C3").Value
If Right$(DestinationFolderName, 1) <> Application.PathSeparator Then
DestinationFolderName = DestinationFolderName & Application.PathSeparator
End If
Set FSO = New FileSystemObject
' Get reference to Destination folder, create it if required
If FSO.FolderExists(DefaultPath & DestinationFolderName) Then
Set DestinationFolder = FSO.GetFolder(DefaultPath & DestinationFolderName)
Else
Set DestinationFolder = FSO.CreateFolder(DefaultPath & DestinationFolderName)
End If
' File Selection Dialog
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker
.AllowMultiSelect = True ' allow user to select multiple files
.InitialFileName = DefaultPath ' set initial folder for dialog
If .Show = False Then Exit Sub ' check if user cancels
For Each SelectedFile In .SelectedItems ' loop over selected files
If SelectedFile Like DefaultPath & "*" Then 'Optional: disallow browsing higher than default folder
FSO.CopyFile SelectedFile, DefaultPath & DestinationFolderName, True ' Copy file, overwrite is it exists
End If
Next
End With
End Sub

how can i walk on folders and sub-folders and get files with specific file type then copy to another directory in VBA?

I want to copy specific file type(*.SLDDRW) from source to destination,in destination path we have lots of folders and sub-folders .in below code i am trying to walk on any sub folders but unfortunately it didn't work and didn't walk all sub-folders S.O can help me?
Sub copy_specific_files_in_folder()
Dim FSO As Object
Dim sourcePath As String
Dim destinationPath As String
Dim fileExtn As String
sourcePath = "C:\Users\6\"
destinationPath = "C:\Users\"
fileExtn = "*.SLDDRW"
If Right (sourcePath, 1) <> "\" Then
sourcePath = sourcePath & "\"
End If
Set FSO = CreateObject ("scripting.filesystemobject")
If FSO.FolderExists(sourcepath) = False Then
MsgBox sourcePath & " does not exist"
Exit Sub
End If
FSO.CopyFile Source:=sourcePath & fileExtn, Destination :=destinationPath
copy_files_from_subfolders
MsgBox "Your files have been copied from the sub-folders of " & sourcePath
End sub
sub copy_files_from_subfolders()
Dim FSO AS Object , fld As Object
Dim fsoFile As Object
Dim fsoFol As Object
sourcePath = "C:\Users\6\"
targetPath = "C:\Users\"
If Right (sourcePath , 1) <> "\" then sourcePath = sourcePath & "\"
Set FSO = createObject("Scripting.FileSystemObject")
Set fld = FSO.getFolder(sourcePath)
If FSO.FolderExists(fld) Then
For Each fsoFol In FSO.GetFolder(sourcePath).SubFolders
For Each fsoFile In fsoFol.Files
If Right (fsoFile, 6) = "sldprt" Then
fsoFile.Copy targetPath
End If
Next
Next
End If
Here's a function that will recursively search a folder and all subfolders for a specific extension and then copy found files to a specified destination:
Sub SearchFoldersAndCopy(ByVal arg_sFolderPath As String, _
ByVal arg_sDestinationFolder As String, _
ByVal arg_sExtension As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim sTest As String
'Test if FolderPath exists
sTest = Dir(arg_sFolderPath, vbDirectory)
If Len(sTest) = 0 Then
MsgBox "Specified folder [" & arg_sFolderPath & "] doesn't exist. Please check spelling or create the directory."
Exit Sub
End If
'Test if Destination exists
sTest = Dir(arg_sDestinationFolder, vbDirectory)
If Len(sTest) = 0 Then
MsgBox "Specified destination [" & arg_sDestinationFolder & "] doesn't exist. Please check spelling or create the directory."
Exit Sub
End If
'FolderPath and Destination both exist, proceed with search and copy
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(arg_sFolderPath)
'Test if any files with the Extension exist in directory and copy if one or more found
sTest = Dir(oFolder.Path & Application.PathSeparator & "*." & arg_sExtension)
If Len(sTest) > 0 Then oFSO.copyfile oFolder.Path & Application.PathSeparator & "*." & arg_sExtension, arg_sDestinationFolder
'Recursively search subfolders
For Each oSubFolder In oFolder.SubFolders
SearchFoldersAndCopy oSubFolder.Path, arg_sDestinationFolder, arg_sExtension
Next oSubFolder
End Sub
Here's an example of how to call it:
Sub tgr()
Dim sStartFolder As String
Dim sDestination As String
Dim sExtension As String
sStartFolder = "C:\Test"
sDestination = "C:\Output\" '<-- The ending \ may be required on some systems
sExtension = "SLDDRW"
SearchFoldersAndCopy sStartFolder, sDestination, sExtension
End Sub

Send Function Result for Use in Sub

I have a sub that calls a function that searches through subfolders and then returns a file path with file name so that the main sub can then use that string to create an attachment. It is a recursive function and as such it keeps resetting my value in strJDFile. I need it to search through all the subfolders as it does, find my file, and then send the strJDFile value through to the main sub. Since it keeps resetting, nothing makes it through to the sub. What am I doing wrong? The function works otherwise. It is just the last step of getting the result to carry through.
Function recurse(sPath As String)
Dim FSO As New FileSystemObject
Dim myFolder As Scripting.Folder
Dim mySubFolder As Scripting.Folder
Dim myFile As Scripting.File
Dim strName As String
Dim strJDFile As String
Dim strDir As String
Dim strJDName As String
Set myFolder = FSO.GetFolder(sPath)
strName = Range("a2").Offset(0, 3)
For Each mySubFolder In myFolder.SubFolders
For Each myFile In mySubFolder.Files
If myFile.name Like "*" & strName & "*" Then
strJDName = myFile.name
strDir = mySubFolder & "\"
strJDFile = strDir & strJDName
Exit Function
End If
Next
recurse = recurse(mySubFolder.Path)
Next
End Function
I looked at multiple posts on this issue including this one VBA macro that search for file in multiple subfolders and I upvoted the answer there, but that is how to set up a recursive, not how to make the value come through to the sub. The issue is as I said above, each time it hits the 'Next' it resets, so my strJDFile value gets set to "" again. But you need the Next after the recurse-strDir in order to get it to keep going through to the next subfolder until if finds the right value. I just need the value to remain instead of coming through as blank. I stepped through with F8 and that is how I found that it resets when it hits the final Next. That is why I added the Exit Function, but that did not work either.
"recurse" is returned, not strJDFile.
Private Sub functionTest()
Dim x As String
Dim fPath As String
fPath = "C:\Test"
x = recurse(fPath)
If x = "" Then x = "No results."
Debug.Print " *** recurse has returned: " & x
Debug.Print "Done"
End Sub
Function recurse(sPath As String)
Dim FSO As New FileSystemObject
Dim myFolder As Scripting.folder
Dim mySubFolder As Scripting.folder
Dim myFile As Scripting.file
Dim strName As String
Dim strJDFile As String
Dim strDir As String
Dim strJDName As String
Set myFolder = FSO.GetFolder(sPath)
' strName = Range("a2").Offset(0, 3)
strName = "test.xlsx"
For Each mySubFolder In myFolder.SubFolders
Debug.Print " mySubFolder: " & mySubFolder
For Each myFile In mySubFolder.Files
If myFile.name Like "*" & strName & "*" Then
strJDName = myFile.name
strDir = mySubFolder & "\"
strJDFile = strDir & strJDName
recurse = strJDFile
Exit Function
Else
Debug.Print " myFile.name: " & myFile.name
End If
Next
recurse = recurse(mySubFolder.path)
Next
End Function

renaming files in excel VBA

I found the following Dos batch script here on the SF forum Rename Multiple files with in Dos batch file and it works exactly as designed :)
My problem is that I execute this from within an excel vba script and
I have to build a delay E.G a Msgbox in the VBA otherwise the VBA script executes faster than the dos script renames the file that I need, resulting in a file not found (it's done on the fly and as I need them).
The excel workbook opens a sheet which is named between 1 and 800. If I want to open file 14.csv(according to the sheet name) the dos script won't help much because it renames the files in sequence, so 1,2,3,4,5 and not 1,2,3,4, 14 (or as required).
a better description maybe:
I open a sheet which is automatically assigned a number(in this case sheet 14) - I then trigger a vba script to find a file with a specific begining in the directory i.e "keyw*.csv" and rename this to E.g "14.csv" which is in turn, imported to its sheet. There is only ever ONE such file that begins "keyw*.csv" present in the directory before it's renamed.
Basically as I see it, I only have the choice of a different function in a DOS batch file or even better, something on the basis of "MoveFile" in a VBA macro, but when I try "MoveFile" in VBA, it doesn't recognize the "*".
Each time I download a file it begins with "keywords_blahbla" so the I need to use a wildcard to find it, in order to rename it.
Obviously I could easily just open the directory and click on the file, but I really would like to automate the whole process so can you possibly guide me in the right direction
thanks
this is the DOS batch I use:
REM DOS FILE
echo on
cd\
cd c:\keywords\SOMETHING\
SETLOCAL ENABLEDELAYEDEXPANSION
SET count=3
FOR %%F IN (c:\keywords\SOMETHING\*.csv) DO MOVE "%%~fF" "%%~dpF!count!.csv" & SET /a
count=!count!+1
ENDLOCAL
and this is the associated VBA script:
Dim vardirfull As String
Dim RetVal
Dim varInput As Variant
Dim fso As Object
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
varfil = ActiveSheet.Name
If Range("A2") <> "" Then
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
'using VBA input to open the file:
'varInput = InputBox("Please enter the NUMBER/NAME highlited at the bottom of this Worksheet or enter 'new' for a new Worksheet")
'If CStr(varInput) <> CStr(ActiveSheet.Name) Then GoTo MustBeSheetName
'-----------------------------------------
'using the DOS Batch:
'RetVal = Shell("C:\keywords\" & vardir & "\changeto3.bat", 1)
'MsgBox "check1 - C:\keywords\" & vardir & "\" & varfil & ".csv"
'-----------------------------------------
'using VBA to search without opening a dialog:(wildcard is not accepted)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile "C:\keywords\" & vardir & "\keyw*.csv", "C:\keywords\" & vardir & "\" & vardir & ".csv"
'MsgBox "pause to allow DOS to fully execute(if used)"
If (fso.FileExists("C:\keywords\" & vardir & "\" & varfil & ".csv")) Then
Set fso = Nothing
GoTo Contin
Else
MsgBox "No such File"
Exit Sub
End If
Contin:
Range("A2:B2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\keywords\" & vardir & "\" & varfil & ".csv", Destination:=Range("$A$2"))
EDIT 1
The script is stating an error "constant expression required" which I don't understand because the variable "vardir" is already defined
Dim vardirfull As String
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
Dim sNewFile As String
Dim sh As Worksheet
Dim qt As QueryTable
Dim sConn As String
Const sPATH As String = "C:\magickeys\" & vardir & "\" **'(error:constant expression required**
Const sKEY As String = "keyw"
'I'm not sure how your sheet gets named, so I'm naming
'it explicitly here
Set sh = ActiveSheet
'sh.Name = "14"
sNewFile = sh.Name & ".csv"
'look for 'keyword' file
sOldFile = Dir(sPATH & sKEY & "*.csv")
'if file is found
If Len(sOldFile) > 0 Then
'rename it
Name sPATH & sOldFile As sPATH & sNewFile
End If
EDIT 2: SOLVED
THANKYOU CHRIS :)
Having played around with the script and tidied mine up a bit, it is now fully functional
As the sheet name is already assigned to any new sheet via the backend, there was no need to set a name but in case anyone would like this, I've included and commented out an Input variation, so you just enter the sheetname and the rest is automated(simply uncomment those lines).
Obviously I have left out the exact type of import at the bottom as everyone would like to import different rows and to change a different filename, simply change the "sKEY" variable.
Thanks again Chris
Sub RenameandImportNewFile()
'Dim varInput As Variant
'varInput = InputBox("Rename this sheet and the File to be imported will be named accordingly or Cancel, vbCancel")
'If varInput = "" Then Exit Sub
'ActiveSheet.Name = varInput
Dim fso As FileSystemObject
Dim Fl As file
Dim vardirfull As String
Dim sPATH As String
Dim sKEY As String
Dim sNewFile As String
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
sPATH = "C:\magickeys\" & vardir & "\"
sKEY = "key"
sh = ActiveSheet.Name
sNewFile = sPATH & sh & ".csv"
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(sNewFile)) Then
GoTo Contin
Else
MsgBox "The File : " & sNewFile & " will now be created"
End If
sOldFile = sPATH & sKEY & "*.csv"
'------------------------------------------
Set fso = New FileSystemObject
Set Fl = FindFile(fso, "C:\magickeys\" & vardir & "\", "key*.csv")
If Fl Is Nothing Then
MsgBox "No Files Found"
Exit sub
Else
MsgBox "Found " & Fl.Name
If Len(sOldFile) > 0 Then
Name Fl As sNewFile
'------------------------------------------
Contin:
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sNewFile, Destination:=Range("$A$2"))
'here the rows you want to import
end sub
include this function after the sub
Function FindFile(ByRef fso As FileSystemObject, FolderSpec As String, FileSpec As String) As file
Dim Fld As folder
Dim Fl As file
Set Fld = fso.GetFolder(FolderSpec)
For Each Fl In Fld.Files
If Fl.Name Like FileSpec Then
' return first matching file
Set FindFile = Fl
GoTo Cleanup:
End If
Next
Set FindFile = Nothing
Cleanup:
Set Fl = Nothing
Set Fld = Nothing
Set fso = Nothing
End Function
Running a batch file to do this is making your code unnecasarily complex. Do it all in VBA. One usefull tool is the FileSystemObject
Early bind by seting a reference to the Scripting type library (Scrrun.dll)
Dim fso as FileSystemObject
Set fso = New FileSystemObject
Late bind like
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
There is lots of info on SO, in the documentation and online
EDIT: FileSystemObject method to match a file using wildcard
Function to search a directory or files matching a pattern, return first matching file found
Function FindFile(ByRef fso As FileSystemObject, FolderSpec As String, FileSpec As String) As file
Dim Fld As Folder
Dim Fl As file
Set Fld = fso.GetFolder(FolderSpec)
For Each Fl In Fld.Files
If Fl.Name Like FileSpec Then
' return first matching file
Set FindFile = Fl
GoTo Cleanup:
End If
Next
Set FindFile = Nothing
Cleanup:
Set Fl = Nothing
Set Fld = Nothing
Set fso = Nothing
End Function
Example of Use
Sub DemoFindFile()
Dim fso As FileSystemObject
Dim Fl As file
Set fso = New FileSystemObject
Set Fl = FindFile(fso, "C:\temp", "File*.txt")
If Fl Is Nothing Then
MsgBox "No Files Found"
Else
MsgBox "Found " & Fl.Name
End If
Set Fl = Nothing
Set fso = Nothing
End Sub
I don't totally understand your workflow here, but hopefully the below will give you enough information to adapt it to your situation.
Sub ImportCSV()
Dim sOldFile As String
Dim sNewFile As String
Dim sh As Worksheet
Dim qt As QueryTable
Dim sConn As String
Const sPATH As String = "C:\Users\dick\TestPath\"
Const sKEY As String = "keyword"
'I'm not sure how your sheet gets named, so I'm naming
'it explicitly here
Set sh = ActiveSheet
sh.Name = "14"
sNewFile = sh.Name & ".csv"
'look for 'keyword' file
sOldFile = Dir(sPATH & sKEY & "*.csv")
'if file is found
If Len(sOldFile) > 0 Then
'rename it
Name sPATH & sOldFile As sPATH & sNewFile
'create connection string
sConn = "TEXT;" & sPATH & sNewFile
'import text file
Set qt = sh.QueryTables.Add(sConn, sh.Range("A2"))
'refresh to show data
qt.Refresh
End If
End Sub

Resources