1

Can anyone help please with the following requirements?

Requirement A:

I'd like to create a loop to run a list of command strings in CMD as long as there's a non-zero value in column C. I think I need to define a variable i for my starting row as this will always be the same, and then run Shell(), pulling the command string from the corresponding cell in Row i, Column F. While Cells(i, "C") is not blank, keep going, increasing i by 1.

Requirement B:

I'd also like to link this macro to work in a directory deposited in a cell by an earlier macro that listed all the files in a selected directory.

This is what I have, without any looping..

Sub Run_Renaming()

    Dim CommandString As Long
    Dim i As Integer
    i = 5

    'Other steps:
        '1 - need to pick up variable (directory of files listed, taken from first macro
        'when doing manually, I opened command, went to correct directory, then pasted
        'the commands. I'm trying to handle pasting the commands. I'm not sure if I need
        'something to open CMD from VBA, then run through the below loop, or add opening
        'CMD and going to the directory in each iteration of the below loop...

        '2 - Need to say - Loop below text if Worksheets("Batch Rename of Files").Cells(i, "C").Value is no blank

         CommandString = Worksheets("Batch Rename of Files").Cells(i, "F").Value
         Call Shell("cmd.exe /S /K" & CommandString, vbNormalFocus)

    'Other steps:
        '3 - need to increase i by 1

        '4 - need to check if C column is blank or not

        '5 - need to end of C column is blank

End Sub

Background:

I'm creating a file renaming tool for a friend. They can use excel, but no programming languages or command prompt. Because of this, I don't want to have any steps, like creating a batch file suggested here, that would complicate things for my friend.

I've created an excel file with:

Tab 1 - a template sheet to create a new file name list. Works by concatenating several cells, adding a filetype, and outputting to a range of cells. Tab two links to this range when creating the renaming command strings for CMD

Tab 2 -

Button 1 - Sub rename() below. VBA to list files in a selected directory in Column C

Column F creates a command line that will rename File A as File B based on inputs to Tab 1 i.e. ren "File 1" "A1_B1_C1.xlsx"

Button 2 - Refers to a renaming macro (requirement 1 and 2 above) that picks up the selected directory from Button 1 and runs through all the renaming command strings while in that directory

Sub rename()

    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$

    InitialFoldr$ = "C:\"

    Worksheets("Batch Rename of Files").Activate
    Worksheets("Batch Rename of Files").Range("C4").Activate

    With Application.FileDialog(msoFileDialogFolderPicker)

        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show

        If .SelectedItems.Count <> 0 Then

            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)

            Do While xFname$ <> ""
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop

        End If

    End With

End Sub
QHarr
  • 83,427
  • 12
  • 54
  • 101
  • Looks like a third requirement at the end i.e. for an additional button. Your requirement B sounds like you might be trying to pick up a folder path and concatenate that with CMD before passing that to the shell command? Think you need a variable to hold the result of the inputbox (that gathers the folder picked by the user in your file looping in folder subroutine) which is accepted as an argument to your renaming procedure. Also, do you mean CMD when you specify Command in the shell script? If so, use a consistent name and make it specific and a non ambiguous term e.g. commandText. – QHarr Nov 08 '17 at 15:26
  • Is the startRow a constant i.e. always the same? Would also need to see at least the signature of the sub that lists the files in a directory. An example of your column F text would help as would an image of some of your data. And the code for the sub which is called by the button push which allows the user to select a folder. – QHarr Nov 08 '17 at 16:07
  • Thanks for the comments QHarr, I've tried to update as much as I can. – James O' Sullivan Nov 08 '17 at 17:55

1 Answers1

1

Caveats:

1) I am not entirely clear on how you data etc is laid out so i am offering a way of achieving your goal that involves the elements i am clear on.

2) To be honest, personally, i would do as much using arrays or a dictionary as possible rather than going backwards and forwards to worksheets.

However...

Following the outline of your requirements and a little rough and ready, we have:

1) Using your macro rename (renamed as ListFiles and with a few minor tweaks) to write the chosen folder name out to Range("A1") in Worksheets("Batch Rename of Files") and the file names to Column C.

2) Using a second macro RenameFiles to pick up the rename shell commands from Column F of Worksheets("Batch Rename of Files"); write these out to a batch file on the desktop; add an additional first line command that sets the working directory to the chosen folder given in Range("A1") (Requirement A). The shell command executes the .bat file, completes the renaming (Requirement B) and then there is a line to remove the .bat file.

I am guessing this is a more efficient way of achieving your goal than looping the column F range executing a command one at a time.

I have not sought to optimize code in any further ways (i have added a few existing typed functions.) There are a number of other improvements that could be made but this was intended to help you achieve your requirements.

Let me know how it goes!

Tab1 layout (Sheet containing new file names):

Batch Rename of Files layout (Sheet containing output of the first macro and the buttons ):

Layout of Worksheet Batch Rename of File

In a standard module called ListFiles:

Option Explicit

Public Sub ListFilesInDirectory()

    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$ 'type hints not really needed
    Dim wb As Workbook
    Dim wsTab2 As Worksheet

    Set wb = ThisWorkbook
    Set wsTab2 = wb.Worksheets("Batch Rename of Files")

    InitialFoldr$ = "C:\"

    Dim lastRow As Long
    lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row

    wsTab2.Range("C4:C" & lastRow).ClearContents 'Get rid of any existing file names

    wsTab2.Range("C4").Activate

    With Application.FileDialog(msoFileDialogFolderPicker)

        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show

        If .SelectedItems.Count <> 0 Then

            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
            wsTab2.Range("A1") = xDirect$

            Do While xFname$ <> vbNullString
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop

        End If

    End With

End Sub

In a standard module called FileRenaming:

Option Explicit

Sub RenameFiles()

    Dim fso As New FileSystemObject
    Dim stream As TextStream
    Dim strFile As String
    Dim strPath As String
    Dim strData As Range
    Dim wb As Workbook
    Dim wsTab2 As Worksheet
    Dim currRow As Range

    Set wb = ThisWorkbook
    Set wsTab2 = wb.Worksheets("Batch Rename of Files")

    strPath = wsTab2.Range("A1").Value2

    If strPath = vbNullString Then

        MsgBox "Please ensure that Worksheet Batch Rename of Files has a directory path in cell A1"

    Else

        If Right$(Trim$(strPath), 1) <> "\" Then strPath = strPath & "\"

        strFile = "Rename.bat"

        Dim testString As String
        Dim deskTopPath As String
        deskTopPath = Environ$("USERPROFILE") & "\Desktop" 'get desktop path as this is where .bat file will temporarily be saved

        testString = fso.BuildPath(deskTopPath, strFile) 'Check if .bat already exists and delete

        If Len(Dir(testString)) <> 0 Then 
            SetAttr testString, vbNormal
            Kill testString
        End If

        Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) 'create the .bat file

        Dim lastRow As Long
        lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row

        Set strData = wsTab2.Range("F4:F" & lastRow) 'Only execute for as many new file names as present in Col C (in place of your until blank requirement)

        stream.Write "CD /D " & strPath & vbCrLf

        For Each currRow In strData.Rows 'populate the .dat file
            stream.Write currRow.Value & vbCrLf
        Next currRow

        stream.Close

        Call Shell(testString, vbNormalFocus)

        Application.Wait (Now + TimeValue("0:00:01"))  'As sometime re-naming doesn't seem to happen without a pause before removing .bat file

        Kill testString

        MsgBox ("Renaming Complete")
    End If
End Sub

Buttons code in Worksheet Batch Rename of Files

Private Sub CommandButton1_Click()

    ListFilesInDirectory

End Sub

Private Sub CommandButton2_Click()
    RenameFiles
End Sub

Example .bat file contents:

Example .bat file contents

VERSION 2

And here is a different version using a dictionary and passing parameters from one sub to another. This would therefore be a macro associated with only one button push operation i.e. there wouldn't be a second button. The single button would call ListFiles which in turn calls the second macro. May require you to go in to tools > references and add in Microsoft Scripting Runtime reference.

Assumes you have a matching number of new file names in Col D of tab 1 as the number of files found in the folder (as per your script to obtain files in folder). I have removed the obsolete type references.Shout out to the RubberDuck VBA add-in crew for the add-in picking these up.

In one standard module:

Option Explicit

Public Sub ListFiles()

    Dim xDirect As String, xFname As String, InitialFoldr As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim dict As New Scripting.Dictionary
    Dim counter As Long

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Tab1") 'Worksheet where new file names are

    counter = 4 'row where new file names start

    InitialFoldr = "C:\"

    With Application.FileDialog(msoFileDialogFolderPicker)

        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr
        .Show

        If .SelectedItems.Count <> 0 Then

            xDirect = .SelectedItems(1) & "\"
            xFname = Dir(xDirect, 7)

            Do While xFname <> vbNullString

              If Not dict.Exists(xFname) Then
                  dict.Add xFname, ws.Cells(counter, "D")  'Or which ever column holds new file names. This add to the dictionary the current name and new name
                  counter = counter + 1
                  xFname = Dir
              End If
            Loop

        End If

    End With

    RenameFiles xDirect, dict 'pass directory path and dictionary to renaming sub

End Sub

In another standard module:

Public Sub RenameFiles(ByVal folderpath As String, ByRef dict As Dictionary)

    Dim fso As New FileSystemObject
    Dim stream As TextStream
    Dim strFile As String
    Dim testString As String
    Dim deskTopPath As String

    strFile = "Rename.bat"
    deskTopPath = Environ$("USERPROFILE") & "\Desktop"
    testString = fso.BuildPath(deskTopPath, strFile)

    'See if .dat file of same name already on desktop and delete (you could overwrite!)
    If Len(Dir(testString)) <> 0 Then
        SetAttr testString, vbNormal
        Kill testString
    End If

    Set stream = fso.CreateTextFile(testString, True)

    stream.Write "CD /D " & folderpath & vbCrLf

    Dim key As Variant

    For Each key In dict.Keys
        stream.Write "Rename " & folderpath & key & " " & dict(key) & vbCrLf 'write out the command instructions to the .dat file
    Next key

    stream.Close

    Call Shell(testString, vbNormalFocus)

    Application.Wait (Now + TimeValue("0:00:01"))  'As sometime re-naming doesn't seem to happen without a pause before removing .bat file

    Kill testString

   ' MsgBox ("Renaming Complete")

End Sub

Scripting run time reference:

Adding runtime reference

Additional method for finding the desktop path. Taken from Allen Wyatt:

In a standard module add the following:

Public Function GetDesktop() As String
    Dim oWSHShell As Object

    Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktop = oWSHShell.SpecialFolders("Desktop")
    Set oWSHShell = Nothing
End Function

Then in the rest of the code replace any instances of deskTopPath =..... e.g.:

deskTopPath = Environ$("USERPROFILE") & "\Desktop"

With

desktopPath = GetDesktop
QHarr
  • 83,427
  • 12
  • 54
  • 101
  • Thanks QHarr for the options, I'll look over more closely as would be good to understand it all. I've tried the above code with the batch file. macro one works, but macro 2 get's stuck defining: Sub RenameFiles() Dim fso As New FileSystemObject You can access the update version here https://drive.google.com/file/d/144zqlxZKUI4Ze1luZl2aH7yhFUjmJpKM/view?usp=sharing – James O' Sullivan Nov 10 '17 at 13:51
  • Have you added the reference to the microsoft scripting runtime? – QHarr Nov 10 '17 at 13:52
  • I have also added some explanation in with the code. And see here for adding the runtime reference library https://stackoverflow.com/questions/3233203/how-do-i-use-filesystemobject-in-vba – QHarr Nov 10 '17 at 13:57
  • Thanks - now get as far as here: Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) but throws an error. I replaced with Set stream = fso.CreateTextFile("D:\Users\JAMOSULL\Desktop" & "\" & strFile, True) and this worked - I'm guessing it's a drive letter issue? However, I then get an error here: Call Shell(testString, vbNormalFocus) – James O' Sullivan Nov 10 '17 at 16:25
  • Just change the following deskTopPath = Environ$("USERPROFILE") & "\Desktop" to deskTopPath = "D:\Users\JAMOSULL\Desktop" and revert the other line back to Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) – QHarr Nov 10 '17 at 16:29
  • Is there a way to fix so that it will work on anyone's computer? This is almost perfect now. I've ran the batch file manually from the desktop and works great! – James O' Sullivan Nov 10 '17 at 16:53
  • That is what this line was doing deskTopPath = Environ$("USERPROFILE") & "\Desktop" – QHarr Nov 10 '17 at 16:54
  • if you press Ctrl + G to open the immediate window and enter the following debug.print Environ$("USERPROFILE") & "\Desktop" what do you get? – QHarr Nov 10 '17 at 16:56
  • I have also edited the answer to include a function that returns the desktop path. Let me know the result of the attempts with the comment above and/or the additional code. Code is written on assumption all machines will be using Windows. If there will be different operating systems or versions of Excel please add that requirement to the question e.g. this code must run on Excel 2013, 2016....... – QHarr Nov 11 '17 at 07:45
  • I copied in the text for the Rename sub, but it still comes up with 'Path not found' and references this line: Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) 'create the .bat file I'm on Windows 7 and running Office 2013 updated file here: https://drive.google.com/file/d/144zqlxZKUI4Ze1luZl2aH7yhFUjmJpKM/view?usp=sharing – James O' Sullivan Nov 14 '17 at 17:42
  • I will have a look tomorrow. What is the value of deskTopPath and strFile when the error occurs? If you open the locals window and step through the code with F8 it will show you the values as they are populated. – QHarr Nov 14 '17 at 17:48
  • Have you added in the function i put at the bottom of the answer GetDesktop? If you add it to a code module and then Ctrl & G to open the immediate window and type the following followed by Enter what do you get: debug.Print GetDesktop – QHarr Nov 15 '17 at 10:23
  • I've updated so that the file is saved to the same directory as the files to be renamed are contained in, which solved the problem. Since the file is deleted anyway, I think this is fine. – James O' Sullivan Nov 15 '17 at 10:32
  • I've now updated the file with instructions/moved some of the columns around. Trying to fix the references - having trouble with counting the files in the folder and running all the renaming commands – James O' Sullivan Nov 15 '17 at 10:33
  • Is that as per the file you uploaded? – QHarr Nov 15 '17 at 10:35
  • Re uploaded - it's only renaming 159 files - having trouble with this: Dim lastRow As Long lastRow = wsTab2.Cells(wsTab2.Rows.Count, "I").End(xlUp).Row Set strData = wsTab2.Range("K5:K" & lastRow) 'Only execute for as many new file names as present in Col I (in place of your until blank requirement) I've put "I" as the column where the new filenames are listed, and "K" as the column where the renaming commands are, but I'm only getting 159 files renamed.... https://drive.google.com/file/d/1AkcE6PSfjWeYxkNxG5hMYvY563nJUh-i/view?usp=sharing – James O' Sullivan Nov 15 '17 at 10:52
  • You should only rename for as many files as there old file names. In this case it would be column G. Dim lastRow As Long lastRow = wsTab2.Cells(wsTab2.Rows.Count, "G").End(xlUp).Row And with this you should get 544 renames (as per upload) – QHarr Nov 15 '17 at 10:59
  • I have tested and it creates a batch file with the right number of entries if you set the LastRow using column G. – QHarr Nov 15 '17 at 11:06
  • The command prompt was running in to some error. I've I keep repeating the renaming function, it renames some more each time, after several clicks, it renamed all the files. – James O' Sullivan Nov 15 '17 at 11:17
  • You might need to increase the Wait time before killing the bat file. This line: Application.Wait (Now + TimeValue("0:00:01")) – QHarr Nov 15 '17 at 11:18
  • Version 4 - now working but on long list of files (maybe files with certain characters?) need to re run Rrenaming action https://drive.google.com/file/d/1SG1aNYVfx7xybSMgQ7RsiL7-Y7I62p1l/view?usp=sharing OK I'll try altering timing – James O' Sullivan Nov 15 '17 at 11:19
  • Give longer wait time. – QHarr Nov 15 '17 at 11:36
  • Great working now! Can close off as answered - do I need to do this? One minor thing - the clear contents line removing old filenames on 'Batch rename of Files' tab is set to start at G5 but also clears G4, the heading. It's not an issue, but any idea what might cause this? What do I need to do to close this off? – James O' Sullivan Nov 15 '17 at 12:09
  • You accept as answer to close by clicking next to the answer. A green tick then appears. This then awards points to me for having assisted. It is a way of encouraging answers and thanking people. I think you must have something else going on because this line wsTab3.Range("G5:G" & lastRow).ClearContents only clear range from G5. You can test this by inserting the word STOP after the this line in the code and then executing ListFilesInDirectory and reviewing sheet Batch Rename of Files. Or insert a break point on this line: wsTab3.Range("G5").Activate and run the same procedure and review. – QHarr Nov 15 '17 at 12:16
  • It's happening when the code hits wsTab3.Range("G5").Activate – James O' Sullivan Nov 15 '17 at 12:28
  • Did you insert the STOP line or the breakpoint and then inspect what had been cleared? It will not happen on wsTab3.Range("G5").Activate as this purely selects a cell and does nothing else with it. – QHarr Nov 15 '17 at 12:30
  • I was using a breakpoint, it's happening just after i press F8 on the ClearContents line: wsTab3.Range("G5:G" & lastRow).ClearContents 'Get rid of any existing file names wsTab3.Range("G5").Activate – James O' Sullivan Nov 15 '17 at 13:12
  • 1) Put a break point on wsTab3.Range("G5:G" & lastRow).ClearContents so will stop before executing this and check that G4 is actually populated. – QHarr Nov 15 '17 at 13:21
  • I added three break points on each line: lastRow = wsTab3.Cells(wsTab3.Rows.Count, "G").End(xlUp).Row wsTab3.Range("G5:G" & lastRow).ClearContents 'Get rid of any existing file names wsTab3.Range("G5").Activate The cell is populated until after ClearContents is run/the activate line is highlighted yellow, then it's empty – James O' Sullivan Nov 15 '17 at 13:25
  • No idea as i cannot duplicate. Maybe add another line after the .clearcontents line saying wsTab3.Range("G4") = "Old Filenames" – QHarr Nov 15 '17 at 13:29
  • OK, thanks - have added the extra code. Sometimes it didn't happen, sometimes it did, so not sure either. Thanks for all your help! – James O' Sullivan Nov 15 '17 at 14:53
  • Not a problem. Maybe also think about things like some code that warns user before renaming, how many files will be renamed so the user can say yes or no? – QHarr Nov 15 '17 at 14:56
  • Yes - will be worthwhile, I've put some text warning in the excel file but will try to build in more checks. Next I want to enable the file to work even if people select a SharePoint folder, rather than one on their desktop. I've tried selecting a mapped directory then listing files, but doesn't work as is. I've found some answers and giving it a go myself atm. Should I create a fresh post/question to explore this if needed? – James O' Sullivan Nov 15 '17 at 17:04
  • Yes you should post a new question if it is a new programming problem though you can always link back to this question for info – QHarr Nov 15 '17 at 17:14
  • Would be interesting to see what solutions you try – QHarr Nov 15 '17 at 17:15