renaming files in excel VBA - excel

Question

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

Answer 1

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

Answer 2

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