Batch changes to many excel files

  • Thread starter Thread starter magmike
  • Start date Start date
M

magmike

Our client sends our invoices via excel, and unfortunately, they send
us one for each location. There are 57 locations. In addition, each
file has a "cover" worksheet with their logo and a summary.

Since we are importing these files into our database for processing -
we currently have to open each file, delete the first worksheet,
select all columns in the next worksheet, unhide all, clear all
formatting and then save as a tab delimited file.

Is there anyway through excel to do this in a batch all at once? If
not, does anyone have a recommendation on a piece of software that
would do this?

thanks in advance,
magmike
 
I'd start by recording a macro that opens a single workbook, copies the second
sheet to a new workbook, closes the original workbook, does all the formatting
and saving that worksheet as a tab delimited file, then closing that workbook
(without saving). (I don't see why you have to touch the first sheet at all.)

Then it would depend on how the workbooks/files are stored. If you keep each in
a common folder, you could loop through all those files and run the (modified)
recorded macro.

This may give you a start:

Option Explicit
Sub testme()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim myTextPath As String
Dim TempWkbk As Workbook
Dim TempWks As Worksheet
Dim NewFileName As String
Dim myExt As String

'path to save the text files
myTextPath = "C:\yourpathtothetextfiles"
myTextPath = "C:\"
If Right(myTextPath, 1) <> "\" Then
myTextPath = myTextPath & "\"
End If

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

myExt = ".xls" '.xlsb, .xlsm, .xlsx ????

'change the extension to what you want
myFile = Dir(myPath & "*" & myExt)
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
'keep looking
myFile = Dir()
Loop

Application.ScreenUpdating = False

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)

Application.EnableEvents = False 'stop workbook_Open
Set TempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr), _
ReadOnly:=True, UpdateLinks:=0)
Application.EnableEvents = True

'go by name??
'tempwkbk.worksheets("SomeCommonName").copy
'or go by location???
TempWkbk.Worksheets(2).Copy 'to a new workbook
Set TempWks = ActiveSheet 'the sheet just created

TempWkbk.Close savechanges:=False

'your formatting stuff here
With TempWks
.UsedRange.Columns.AutoFit '??
'anything else
End With

'take the old name, remove the extension, add .txt
NewFileName = Left(myNames(fCtr), _
Len(myNames(fCtr)) - Len(myExt)) & ".txt"

With TempWks
'overwrite any existing file???
Application.DisplayAlerts = False
.Parent.SaveAs Filename:=myTextPath & NewFileName, _
FileFormat:=xlText
Application.DisplayAlerts = True
.Parent.Close savechanges:=False
End With
Next fCtr
End If

Application.ScreenUpdating = True

End Sub
 
See alsohttp://www.rondebruin.nl/copy4.htm
Click to expand...

Thank you so much for this - this is extremely helpful. I do have a
couple of questions:

RE:
-----------------------
myTextPath = "C:\yourpathtothetextfiles"
myTextPath = "C:\"
-----------------------

Why do you have two paths here? Do I need to have the "C:\" directory
- or are you just showing me that I could save a copy to more than one
location if I wanted to?

RE:
-----------------------
'go by name??
'tempwkbk.worksheets("SomeCommonName").copy
'or go by location???
TempWkbk.Worksheets(2).Copy 'to a new workbook
Set TempWks = ActiveSheet 'the sheet just created
-----------------------
The first sheet (the one I do not want) is always named Summary.
However, sheet 2, the one I DO want - is always named the number of
the location - so the second option here will be my choice. Unless
there is a way to delete the "summary" sheet by name before saving a
copy of the workbook as text. However, I noticed you have set the file
to read-only - so I would have to change that if it were possible to
do it the delete sheet one way. Correct?

RE:
-----------------------
'your formatting stuff here
With TempWks
.UsedRange.Columns.AutoFit '??
'anything else
End With
----------------------
I apologize, but I am new at VB for Excel - normally doing the Access
part - is there a way here to remove the last row that has text in any
of the cells? The last line is always the name of the location and a
total of all the deductions for that location. This is getting
imported with the data too.

Also, for some reason, in some of the files, but not all - when
imported - it imports blank rows beneath all the data - usually tens
of thousands - why is this, and would there be a way to stop that as
well?

Also - is there a resource that would show a list of all the possible
formatting commands?

And finally - in some of the files - there are multiple blank columns
between the visible data and the invisible data (which I want to
import when it is there). I have modified my import spec to skip these
fields - however, i'm worried that the number of these blank columns
may change in the future and screw up my import spec's effectiveness.
Is there a way to remove these empty columns? all the other columns
with data in them would at least have a field name in the first cell,
while these blank columns do not.

Thanks again for your help!
 
See alsohttp://www.rondebruin.nl/copy4.htm
Click to expand...

Thank you for the link to your page - I have learned much from it
already. I am looking at the "Merge_Data_To_Text_File" article as a
possible way to achieve my goal. However, if I do it that way, I will
need to add a column to each file first. The following facts are also
necessary to understand my next question:

1. Each of the 57 files represents an office location
2. The worksheet does NOT include a column for a location identifier
3. The second worksheet (the one I will be using) is named by the
location's number

So therefore, would it be possible to first open each workbook, insert
a new column before the A column on the second worksheet and add the
second worksheet's name (also the location number) in the A column in
each row where there is also other data?

Thanks in advance for your help!

magmike
 
That was from my post, not Ron's.

I used this line:
myTextPath = "C:\yourpathtothetextfiles"
Click to expand...
To show you where to enter your path

But I superseded that line for my own testing with this line:
myTextPath = "C:\"
Click to expand...

And I forgot to delete that second line.
 
Try this tester, do not forget to copy the function below the macro

Change the path to the folder with the files
MyPath = "C:\Users\Ron Desktop\Test"


Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim Lrow As Long

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron Desktop\Test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then
On Error Resume Next
Lrow = LastRow(mybook.Worksheets(2))

With mybook.Worksheets(2)
.Range("A1").EntireColumn.Insert
.Range("A1:A" & Lrow).Value = .Name
End With

If Err.Number > 0 Then
ErrorYes = True
Err.Clear
'Close mybook without saving
mybook.Close savechanges:=False
Else
'Save and close mybook
mybook.Close savechanges:=True
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 
Back
Top