renaming files in excel VBA

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

1. 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).

2. 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

Solution 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

Solution 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

Comments

[Admin]

K, I have put an answer at the top with EDIT 1

[Admin]

as you can see in the original, I tried that but the wildcard in keyw*.csv is not accepted

[Admin]

,thanks 4 all your help chris, I've tried everything and your latest attempt to help requires some undefined object, but which one?...no idea. I have tried MS DAO 2.51/3.51 compatible and 3.60 using excel 2007 to no avail :(

[chris neilsen]

You need to set a reference: in vba editor go to Tools References menu, select "Microsoft Scripting Runtime". This adds a reference to the file Scrrun.dll