VBA - File Cycle

mlocmcgash

Hi, this is my first post so I am hoping that one of you experienced guys can help me out.

I am trying to write a Macro that will:
1: let me select a folder of choice (though don't mind hardcoding a certain folder instead, dialog box is just good so I can test things out)
2: will then scroll through all the files in that folder (without opening them in Excel)
3: will save the files all to a folder time stamped with the time of the run.
4: Will do this a number of times (i.e. different folders with diff timestamps)

This is what I have (and it actually works):

##################################################
Option Explicit

Dim sDateTime As String
Dim x As String
Dim y As String
Dim z As String

Dim intX As Integer

Dim fileOpen As FileDialog
Dim fileSave As FileDialog
Dim foldPick As FileDialog

Dim selFold As String
Dim fsSelItm As String
Dim Repl As String

Dim intMsg As String
Dim FileName As String
Dim arrFileNames() As Variant

Dim loopCount As Long
Dim numFiles As Integer

Sub format()

'Turn off all normal Excel alerts
Application.DisplayAlerts = False

'Initialise the loop counter and the loop control to 0 before looping
loopCount = 0
intX = 0

'Show FileDialog Object for File selection
Application.FileDialog(msoFileDialogFolderPicker).Show

'Generate FileDialog Object for File selection
Set foldPick = Application.FileDialog(msoFileDialogFolderPicker)
With foldPick
.AllowMultiSelect = False
.InitialFileName = ""
End With

selFold = foldPick.SelectedItems(1)


'Returns any file in the selected folder with that extension
FileName = Dir(selFold & "\*.mp3")

Do While intX < 5
'Find out current date and time using function "now"
sDateTime = Now

'Change the format of the date/time so it can be used to name a folder
'i.e. no /'s or :'s or spaces
sDateTime = Replace(sDateTime, "/", "_")
sDateTime = Replace(sDateTime, " ", "__")
sDateTime = Replace(sDateTime, ":", "_")

'Create a folder using the date and time stamp gotten previously
MkDir ("C:\Documents and Settings\colm_mcginn\Desktop\SaveTest\" & sDateTime)


'Loops through all the files in the selected directory with the required extension
FileName = Dir(selFold & "\*.mp3")

Do While FileName <> ""


'If the end of the files has not been reached, keep scrolling through them
If FileName = "" Then
intMsg = MsgBox("There are no files in this folder")
Else
ReDim Preserve arrFileNames(loopCount)
arrFileNames(loopCount) = FileName


'Replace the .mp3 extension with xls before saving
Repl = Replace(FileName, "mp3", "xls")

'Give the files their new name before saving
FileName = Repl

If FileName <> "" Then

'Save a copy of the updated (diff) worksheet to the selected directory/folder
'so you can continue with the current macro

ActiveWorkbook.SaveCopyAs ("C:\Documents and Settings\colm_mcginn\Desktop\SaveTest\" & sDateTime & "\" & FileName)
'MsgBox (FileName & " was saved")

End If

'Go to next file in the selected folder
FileName = Dir


'Increment the loop counter
loopCount = loopCount + 1


End If


Loop

'Increment the loop control (number of folders)
intX = intX + 1

Loop


'Set the myFileDialog object variable to Nothing freeing memory.
Set fileOpen = Nothing
Set fileSave = Nothing
Set foldPick = Nothing


End Sub

################################################
My problem is that this works perfectly on MS Excel 2003 but not on 2000 (which I am limited to by work constraints). Is there any amendments that I can make that will allow it to work on Excel 2000?
I have tried: "Application.GetOpenFileName" but I can't get ".SelectedItem" from this and also it opens the file rather than just taking it's filename so I can use it.

Any help/suggestions would be GREATLY appreciated.

Thanks.

maxcherry

OK - First tip I can give you is that you should never program in one version of a language and expect it to be backward compatible.

I think(just did a quick google on your problem) it is with the objects you are using:

Try this:


Dim fileToOpen As Object

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")

bonkey

'Replace the .mp3 extension with xls before saving
Repl = Replace(FileName, "mp3", "xls")
...
ActiveWorkbook.SaveCopyAs ("C:\Documents and Settings\[b]colm_mcginn[/b]\Desktop\SaveTest\" & sDateTime & "\" & FileName)

3: will save the files all to a folder time stamped with the time of the run.

Not quite what your code is doing, Colm

mlocmcgash

maxcherry wrote:

OK - First tip I can give you is that you should never program in one version of a language and expect it to be backward compatible.

I think(just did a quick google on your problem) it is with the objects you are using:

Try this:


Dim fileToOpen As Object

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")

Thanks for replying max but I have tried this already (Application.GetOpenFilename), this actually opens the files, I just need to get the file path/file name of the files in a folder I select. The reason I used 2003 was to prove I could get my program to work, now I'm just trying to make it work on 2000. This is just a snippet of a much bigger program, the dialog boxes are really the only part that don't work but I can't find another way to select folders/files and get a string output with their full paths etc.

mlocmcgash

bonkey wrote:

'Replace the .mp3 extension with xls before saving
Repl = Replace(FileName, "mp3", "xls")
...
ActiveWorkbook.SaveCopyAs ("C:\Documents and Settings\[b]colm_mcginn[/b]\Desktop\SaveTest\" & sDateTime & "\" & FileName)

Not quite what your code is doing, Colm

It's not exactly what it's doin bonkey but it does what I want (prob didn't explain it properly though). I know the time stamps aren't fully accurate but they're close enough for my use.
Any ideas on the 2003 - 2000 problem?
Thanks for the repy by the way.

maxcherry

mlocmcgash wrote:

Thanks for replying max but I have tried this already (Application.GetOpenFilename), this actually opens the files, I just need to get the file path/file name of the files in a folder I select. The reason I used 2003 was to prove I could get my program to work, now I'm just trying to make it work on 2000. This is just a snippet of a much bigger program, the dialog boxes are really the only part that don't work but I can't find another way to select folders/files and get a string output with their full paths etc.

OK so you say you are after the path - what about this then
This will display something like \FRED\FRED\FRED\MYFILE.TXT

What you need to do is count the amount of \ in the returned string if it is greater than 1 then remove the text after the last one - thus you will have:

\FRED\FRED\FRED

See comment in code below:

Sub GetPath()
Dim MyPath As String
Dim FName As Variant

MyPath = Application.DefaultFilePath 'or use "C:\Data"
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="All files, *.*")

If FName = False Then
'do nothing
Else
' Parse the var FName here
MsgBox "File path and name is: " & FName
Set FName = Nothing
End If


End Sub

bonkey

Your best bet is probably to have a look at FSO (FileScriptingObject). As far as I can remember, you can reference it from either version of Excel and use it for what it is you want to do.

jc

mlocmcgash

Thanks again lads.
max: I will try that bit of code and see how I get on, if it does what you say then thats all I need I think.
bonkey: As fas as the FSo goes, that is my problem, Excel 2000 is on the computer I have to work off and I can't get 2003 onto it (not allowed), 2003 has the appropriate fso for the dialogues to work but 2000 doesn't. If you know how I can fix this that would solve the problem immediately.

mlocmcgash

Lads, I obvioulsy didn't explain it well enough cos if I did you would have pointed out how obvious the answer was immediately.
It was pretty much what you said Max, all I had to do was declare a string with a default path in it and then 'dir' through that, I for some reason had the dialog problem in my head even though my finished program doesn't want it.
Sorry for wasting your time folks, thanks again.