Need to call a batch file when a workbook is opened

[ianpwilliams]

Hi all

I want to have a batch file that runs automatically whenever a particular workbook is opened. So I need help working out what VBA command to use (the Shell command?), and where to put it in Excel.

I could also do with help getting the batch file code working if anyone here knows about that stuff:

echo off
:: set drive=M:\mybackup
SET dateNtime="%date:~0,2%-%date:~3,2%-%date:~6,6%_%time:~0,2%-%time:~3,2%"
set backupcmd=xcopy /s /c /d /e /h /i /r /k /y
%backupcmd% "*.xls" "\Backups\*%dateNtime.xls"

What I want this batch file to do is copy all "xls" files from the current directory to a subdirectory, with the date and time appended on the end, and put them in a "Backups" subdirectory. Then I can copy the batch file to all of the other directories without having to change filenames. Also there is one directory which has five to backup rather than one. Does anyone know how I can get this batch file work?

And does anyone know where I can put the Shell command in Excel to run the batch file when the workbook is opened (and possibly when certain VBA subroutines are ran)?

[ragulduy]

You can use the workbook open event to run something whenever the workbook is opened. In the ThisWorkbook object (in microsoft excel objects in the solution explorer for your vba project) put something like:

Private Sub Workbook_Open()
  'do this code
End Sub

I'm not good with batch file code but you might be able to use something like this to just do it from vba:

Private sub workbooks_open()

Dim fs, fol, fil

Set fs = CreateObject("Scripting.filesystemobject")
Set fol = fs.getfolder("M:\mybackup")
For Each fil In fol.Files
    If Strings.Right(fil, 4) = ".xls" Then
        fil.Copy fil.ParentFolder & "\Backups\" & Replace(fil.name, ".xls", "") & replace(replace(Now(),"/",""),":","") & ".xls"
    End If
Next

End Sub

[Solus Rankin]

Dim strBatch as String
strBatch = "C:\SomeFile.bat"

Shell strBatch

This is the simple shell command to run it.

I looks like to be you're going to lose the original name of the file you're backing up to the new folder. Also you may want to check for the existence of the backup folder before you try to move anything to it.

Edit:

since it is a backup why don't you replace /y with /z? Or at least add /z. If you're naming the files current time and date you don't want a chance of over-writing a different file do you?

[ianpwilliams]

I tried that code, slightly modified in an attempt to set the path as the current path:

Private Sub workbooks_open()

Dim fs, fol, fil

Set fs = CreateObject("Scripting.filesystemobject")
Set fol = fs.getfolder(ActiveWorkbook.Path)
For Each fil In fol.Files
    If Strings.Right(fil, 4) = ".xls" Then
        fil.Copy fil.ParentFolder & "\Backups\" & Replace(fil.Name, ".xls", "") & Replace(Replace(Now(), "/", ""), ":", "") & ".xls"
    End If
Next

End Sub

But nothing gets copied when I open the workbook. And I tried it before and after manually creating the "Backups" folder (although I'd like to avoid having to create that folder in every other folder anyway if I can avoid it).

[ianpwilliams]

To be honest I took the code from online, so I don't know what the various switches do in the batch file. I'd really like the copied files(s) to have the date and time stuck on the end though, rather than just replacing the original filename.

And I don't mind if I use a batch file called from VBA, or just VBA.

[ragulduy]

how about this:

Private Sub workbooks_open()

Dim fs, fol, fil

Set fs = CreateObject("Scripting.filesystemobject")
On Error GoTo not_found
Set fol = fs.getfolder(ActiveWorkbook.Path & "\Backups\")
For Each fil In fol.Parentfolder.Files
    If Strings.Right(fil, 4) = ".xls" Then
        fil.Copy fol & "\" & Replace(fil.Name, ".xls", "") & Replace(Replace(Now(), "/", ""), ":", "") & ".xls"
    End If
Next
Exit Sub
not_found:
Set fol = fs.createfolder(ActiveWorkbook.Path & "\Backups\")
Resume Next
End Sub

That will create the backups folder if it doesn't already exist. I've tried it on a test folder on my system and it copies everything ok. Have you put it in the thisworkbook object and not in a new module?

[Solus Rankin]

/y will overwrite any existing files without prompt
/z puts a tracker on files in case you need to pick back up from where you left off.

The code I left above will call the .bat file from vba.

[ianpwilliams]

Thanks XeRo, but I'm starting to think that maybe using VBA would be the better way to go (now that I know that I can do that!).

Your code does work now yudlugar, although I had to change the name of the subroutine to workbook_open() for it to work. Not sure why. One minor nitpick - would it be possible to have a space between the filename and the date, like there is between the date and time? Not that it really matters.

Also, if I wanted to do this backup every time someone ran one of my other subroutines, would I just insert something at the beginning of my subroutine, something like:

"Call workbook_open()"?

And is it better to use "Call" or "Application.Run"?

Would the user still be returned to my subroutine afterwards?

[Solus Rankin]

Call workbook_open or just workbook_open, but you'll have to remove the Private from before Sub. If you want to do it that way you should probably put it in a standard module, change the name and call it from your workbook_open event.

I'm assuming the others Subs you're talking about are in the same workbook?

Edit:

You do want it to automatically run every time the workbook is open correct?

[ragulduy]

See Xero Solus' post regarding running from other modules. To add the space:

fil.Copy fol & "\" & Replace(fil.Name, ".xls", "") & " " & Replace(Replace(Now(), "/", ""), ":", "") & ".xls"

[ianpwilliams]

Ok, sorry to be a pain, but I could do with changing this slightly. The setup I have is this:

I have 12 folders. 11 folders each contain 1 workbook, and 1 folder contains 5 workbooks, totalling 16 workbooks. All of the workbooks contain subroutines which send and receive data to each other. The whole project is about to be tested in work, so I want regular backups of the files during the testing period.

So I originally wanted each workbook to back itself up when opened. But that doesn't back up any other workbooks that have data sent to them.

So then I thought, how about if each workbook had an "on-open" subroutine that went up two parent folders, and then copied (with the date and time added at the end) the entire project folder to a "Backups" folder. This would certainly be a tidier way of doing it. But of course, the "Backups" folder would get bigger and bigger, so it would take longer and longer to open each workbook every time. Unless VBA has some kind of switch to only back up the files that have been modified since the last backup?

I'd rather not insert code into all of my existing subroutines to backup the source and destination files if I can help it!

[ragulduy]

so something like:

Sub workbook_open()
Dim fs, copy_folder, dest_folder
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder = fs.GetFolder(ActiveWorkbook.Path).ParentFolder.ParentFolder
Set dest_folder = fs.CreateFolder(copyfolder.ParentFolder & "\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
fs.copyfolder copy_folder, dest_folder
End Sub

would go back two parent folders and copy the entire folder/file structure to a backup with the date

[ianpwilliams]

That almost works, although it goes back one two many folders. The process runs from one of the spreadsheets, which is in a folder, so it needs to go out of that folder, then up one more folder (outside the main project folder), and then copy that folder to a backup folder. It seems to do that, but another folder up, so I get all of the versions copied into a backup.

[ianpwilliams]

Also, I could ideally do with that "Backup" folder being stored inside the project folder, otherwise it could get messy. But then I suppose I would have to specify all of the folder names in order to stop the process from also copying the "Backup" folder wouldn't I?

[ianpwilliams]

Something like this (although it says "invalid qualifier"):

Sub workbook_open()
Dim fs, copy_folder(1 To 12), dest_folder
Dim A As Integer
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder(1) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\BRI BRISTOL\"
Set copy_folder(2) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\CAR CARDIFF\"
Set copy_folder(3) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\CHE CHESTER\"
Set copy_folder(4) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\CPH TRACKER\"
Set copy_folder(5) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\LEE LEEDS\"
Set copy_folder(6) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\LIL LIVERPOOL LEGAL\"
Set copy_folder(7) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\LIM LIVERPOOL MEANS\"
Set copy_folder(8) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\LON LONDON\"
Set copy_folder(9) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\MAN MANCHESTER\"
Set copy_folder(10) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\NOT NOTTINGHAM\"
Set copy_folder(11) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\STL SOUTH TYNESIDE LEGAL\"
Set copy_folder(12) = fs.GetFolder(ActiveWorkbook.Path).ParentFolder & "\STM SOUTH TYNESIDE MEANS\"
Set dest_folder = fs.CreateFolder(copy_folder.ParentFolder & "\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
For A = 1 To 12
    fs.copyfolder copy_folder, dest_folder
Next
End Sub

[ianpwilliams]

Never mind, I created an error handling routine. Thanks again everyone.

[ragulduy]

Maybe:

Sub workbook_open()
Dim fs, copy_folder, dest_folder, fol
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder = fs.GetFolder(ActiveWorkbook.Path).ParentFolder
Set dest_folder = fs.CreateFolder(copyfolder & "\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
For Each fol In copy_folder.Folders
 If Strings.Mid(fol, 5, 1) = " " Then
    fol.Copy dest_folder
 End If
Next
End Sub

[ianpwilliams]

Interesting. Each time I run it it says "Object does not support this property or method" on the line:

For Each fol In copy_folder.Folders

But it does create a Backup folder each time (in the project folder). It just doesn't put anything in it.

[ragulduy]

Sorry my mistake, should be copyfolder.subfolders not copyfolder.folders

[ianpwilliams]

I'm not getting any errors, but it's not copying anything either. This is what I have. Incidentally should it not be 4 rather than 5 for the "Mid" command? I assume it's looking for the space after the first three letters? It doesn't copy anything either way anyway though:

Sub workbook_open()
Dim fs, copy_folder, dest_folder, fol
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder = fs.GetFolder(ActiveWorkbook.Path).ParentFolder
Set dest_folder = fs.CreateFolder(copy_folder & "\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
For Each fol In copy_folder.subfolders
 If Strings.Mid(fol, 4, 1) = " " Then
    fol.Copy dest_folder
 End If
Next
End Sub

[ianpwilliams]

I put a MsgBox command in the loop, and "fol" equals the full path from start to finish. So doesn't that means it's looking for the 4th (or 5th) character at the beginning of the full path instead of just the folder?

[ragulduy]

Try
If Strings.Mid(fol.name, 4, 1) = " " Then
?

That should just look at the name not the full path

[ianpwilliams]

Never mind it works now. Do you know what could have caused it to go wrong before? I did have another Excel spreadsheet open at the same time. Maybe it took ActiveWorkbook.Path from there or something, which took me to My Documents? Because if that was the case, then I'd have to be careful that the same thing didn't happen in work.

[ianpwilliams]

Something went horribly wrong then...it was copying hundreds of megabytes of data and I had to stop it (which wasn't easy with all the MsgBox's popping up!):

Sub workbook_open()
Dim fs, copy_folder, dest_folder, fol
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder = fs.GetFolder(ActiveWorkbook.Path).ParentFolder
Set dest_folder = fs.CreateFolder(copy_folder & "\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
For Each fol In copy_folder.subfolders
 MsgBox (fol)
 MsgBox (copy_folder)
 If Strings.Mid(fol.Name, 4, 1) = " " Then
    fol.Copy dest_folder
 End If
Next
End Sub

[ragulduy]

You could try referencing ThisWorkbook.path rather than activeworkbook.path which should give you the workbook the code is stored in not the active one. Although if you are running the code on the open event they should be the same.

Note, the last code I posted in the previous code will also recreate the other folders/structure in the backup folder.

[ragulduy]

Ok I've tried this on a similar folder set-up to what you described and it works ok for me. I'm pretty much out of ideas after this so might be worth going back to the batch method

Sub workbook_open()
Dim fs, copy_folder, dest_folder, fol
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder = fs.GetFolder(ActiveWorkbook.Path).ParentFolder
Set dest_folder = fs.CreateFolder(copy_folder & "\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
For Each fol In copy_folder.SubFolders
 If Strings.Mid(fol.Name, 4, 1) = " " Then
    fol.Copy dest_folder & "\" & fol.Name
 End If
Next
End Sub

[ianpwilliams]

Excellent! And you read my mind, I was just about to ask how I could retain the folder structure.

So if they are probably going to be the same anyway (with the code being in ThisWorkbook), would you suggest I go for Thisworkbook.path or activeworkbook.path?

[ragulduy]

Assuming you are only going to be running the macro on the workbook which the macro is stored in, I would use thisworkbook.path

[ianpwilliams]

Ok thanks. Just one last thing (which I tried to do myself, but couldn't get it to work) - how can I modify the code so that all the date and time-stamped "Backup" folders go inside one "Backups" folder in the project folder? I tried this, but it didn't work:

Sub workbook_open() ' Copy all project files to a "Backup" folder, retaining the folder structure, with the date and time added to the end
Dim fs, copy_folder, dest_folder, fol
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder = fs.GetFolder(ThisWorkbook.Path).ParentFolder
Set dest_folder = fs.CreateFolder(copy_folder & "\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
For Each fol In copy_folder.SubFolders
 If Strings.Mid(fol.Name, 4, 1) = " " Then
    fol.Copy dest_folder & "\Backups" & "\" & fol.Name
 End If
Next
End Sub

[ragulduy]

You need to create the destination folder before trying to copy something to it. Assuming you have already made "\backups" then maybe you can use:

Sub workbook_open() ' Copy all project files to a "Backup" folder, retaining the folder structure, with the date and time added to the end
Dim fs, copy_folder, dest_folder, fol
Set fs = CreateObject("Scripting.filesystemobject")
Set copy_folder = fs.GetFolder(ThisWorkbook.Path).ParentFolder
Set dest_folder = fs.CreateFolder(copy_folder & "\Backups\Backup " & Replace(Replace(Now(), "/", ""), ":", ""))
For Each fol In copy_folder.SubFolders
 If Strings.Mid(fol.Name, 4, 1) = " " Then
    fol.Copy dest_folder & "\" & fol.Name
 End If
Next
End Sub

[ianpwilliams]

Great, that works perfectly!

Thanks for all your help, much appreciated!

[ianpwilliams]

Sorry, one more follow-up question...as multiple users will be using these spreadsheets (although not many), is there something I can put in to allow for two users opening two spreadsheets at exactly the same second, causing an error? I don't mind what. Maybe one could overwrite the other, or if the folder already existed then it could not bother saving. Just something so that an error didn't come up and confuse the user.

I just noticed it, because I chose to add the code to run before closing the workbook, and when I tried to close all the workbooks at once, it produced an error, because they were all trying to use the same backup name.

Would an "On error resume next" the line before the copy take care of that?