Batching files through a macro
 

I have created a macro to modify exported files from a student managament
system into the a format for submission of grades, but I cannot accomplish
two things with my limited knowledge (the macro deletes 3 columns, reorders
what is left, formats one and saves as a csv).

1) How can I batch all of the files through the macro (all in one folder)?

2) How can I save them with their original names?

Thanks in advance for your help!

Batching files through a macro
 

One way:

Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

'change to point at the folder to check
myPath = "C:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

'your macro that does the work goes
here

tempWkbk.Close savechanges:=True

Next fCtr

End If

End Sub

If you have trouble with your code that does the work, post back what you have.

emt29165 wrote:

I have created a macro to modify exported files from a student managament
system into the a format for submission of grades, but I cannot accomplish
two things with my limited knowledge (the macro deletes 3 columns, reorders
what is left, formats one and saves as a csv).

1) How can I batch all of the files through the macro (all in one folder)?

2) How can I save them with their original names?

Thanks in advance for your help!

--

Dave Peterson

Batching files through a macro
 

Have a look at FileSearch and FoundFiles in Help. You should find a nice
example you can modify for your purposes.

"emt29165" wrote:

I have created a macro to modify exported files from a student managament
system into the a format for submission of grades, but I cannot accomplish
two things with my limited knowledge (the macro deletes 3 columns, reorders
what is left, formats one and saves as a csv).

1) How can I batch all of the files through the macro (all in one folder)?

2) How can I save them with their original names?

Thanks in advance for your help!

Batching files through a macro
 

Thanks Dave,
I added my code and it works great.
One more question...how can I get them to save in .csv rather than back to
xls?
Here is the complete code as I have it (with mine inserted into yours)....
[thanks again!]

Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

'change to point at the folder to check
myPath = "C:\Documents and Settings\mpethel\My Documents\Excel"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

Columns("A:F").Select
Selection.ClearContents
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select

tempWkbk.Close savechanges:=True

Next fCtr

End If

End Sub

Batching files through a macro
 

I got rid of the Select/Selection stuff (but I think I did the same as your
code):

Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

Dim newName As String

'change to point at the folder to check
myPath = "C:\Documents and Settings\mpethel\My Documents\Excel"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

With ActiveSheet
.Columns("A:F").Delete Shift:=xlToLeft
.Columns("C:C").Cut
.Columns("A:A").Insert Shift:=xlToRight
.Columns("C:C").Cut
.Columns("B:B").Insert Shift:=xlToRight
.Rows("1:1").Delete Shift:=xlUp
End With

'get rid of the .xls extension
newName = Left(tempWkbk.FullName, Len(tempWkbk.FullName) - 4)

'save it as .csv
tempWkbk.SaveAs Filename:=newName, FileFormat:=xlCSV

'close it without saving
tempWkbk.Close savechanges:=False

Next fCtr

End If

End Sub


emt29165 wrote:

Thanks Dave,
I added my code and it works great.
One more question...how can I get them to save in .csv rather than back to
xls?
Here is the complete code as I have it (with mine inserted into yours)....
[thanks again!]

Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

'change to point at the folder to check
myPath = "C:\Documents and Settings\mpethel\My Documents\Excel"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

Columns("A:F").Select
Selection.ClearContents
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select

tempWkbk.Close savechanges:=True

Next fCtr

End If

End Sub

--

Dave Peterson