Office - guardar como en excel

Hola a tod@s,

A ver si alguien puede echarme una mano. He estado buscando en el foro y no he encontrado nada parecido, pero supongo que con el nivel que teneís no será para vosotr@s complicado.

El asunto es el siguiente:

Recibo cada día cientos de ficheros excel que debo abrir y guardar como Libro de Microsotf Excel 97-2000 y 5.0/95 ( Creo que eso es FileFormat:= _xlExcel9795) para que otra aplicación pueda leerlos.

El caso es que me han comentado que podría tenerlos todos en una carpeta y ejecutando un programa en VB se transformen auntomáticamente a ese formato. ¿ Es eso posible? y si lo es ¿puede alguien indicarme el código?.

Muchas gracias, me sería de muchísima ayuda.

Saludos

María

Option Explicit
Option Private Module

'---------------------
'By JuanC Dic-2005
'---------------------

'-------------------------------------------------
'Esto es sólo una idea de como podría resolverse
'el problema planteado.
'Obviamente puede mejorarse y adaptarse mejor
'a una situación particular.
'-------------------------------------------------

'Carpeta donde están los archivos
Const cDIR_ORIGEN = "C:\MyFolder"
'Extensión de archivo a buscar y modificar
Const cEXT = "*.xls"
'Prefijo para guardar el archivo convertido con otro nombre
Const cPREFIJO = "9795"

Sub Main()
On Error Resume Next
Application.ScreenUpdating = False
tConvertirArchivos
Application.ScreenUpdating = True
End Sub

Private Function tConvertirArchivos()
On Error Resume Next
tBuscarArchivos
End Function

Private Function tBuscarArchivos()
Dim fs, i%
On Error Resume Next
Set fs = Application.FileSearch
With fs
.LookIn = cDIR_ORIGEN
.Filename = cEXT
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
If LCase(ThisWorkbook.FullName) <> LCase(.FoundFiles(i)) Then
tProcesarArchivo .FoundFiles(i)
End If
Next i
End If
End With
Set fs = Nothing
End Function

Private Function tProcesarArchivo(ByVal sFName As String)
Dim sNewName$, wb
On Error Resume Next
sNewName = Mid(sFName, 1, InStrRev(sFName, "\"))
sNewName = sNewName & cPREFIJO & Mid(sFName, InStrRev(sFName, "\") + 1)
Set wb = Workbooks.Open(Filename:=sFName)
wb.SaveAs Filename:=sNewName, FileFormat:=xlExcel9795
wb.Close SaveChanges:=False
Set wb = Nothing
End Function

Saludos y buena suerte, desde Buenos Aires, JuanC