die letzten zig Dateien wurden alle unter 2010 in einem Ordner gespeichert.
Nun sollten diese Dateien unter 2003 zur Verfügung stehen.
Wie geht man da am effizientesten vor?
Gruß
Jean
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub covertToxl2003()
Dim objWB As Workbook
Dim strPath As String, strFile As String
Dim lngCalc As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
strPath = "E:\Forum"
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xl*", vbNormal)
Do While strFile <> ""
Set objWB = Workbooks.Open(strFile, UpdateLinks:=False)
If objWB.FileFormat <> 56 Then
objWB.SaveAs strPath & Left(strFile, InStrRev(strFile, ".")) & "xls", FileFormat:=56
End If
objWB.Close
strFile = Dir
Loop
ErrExit:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'covertToxl2003'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Modul2"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
End Sub
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub covertToxl2003()
Dim objWB As Workbook
Dim strPath As String, strFile As String
Dim lngCalc As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
strPath = "E:\Forum"
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xl*", vbNormal)
Do While strFile <> ""
If strFile <> ThisWorkbook.Name Then
Set objWB = Workbooks.Open(strFile, UpdateLinks:=False)
If objWB.FileFormat <> 56 Then
objWB.SaveAs strPath & Left(strFile, InStrRev(strFile, ".")) & "xls", FileFormat:=56
End If
objWB.Close
End If
strFile = Dir
Loop
ErrExit:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'covertToxl2003'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Modul2"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
End Sub