SaveAs Datei zu gross
Detlef
mit folgendem Code erstelle ich Einzeldateien aus einer ca. 20 MB xls.
Sub procBD_Datei_erstellen()
Dim strFormKopSP As String
Dim intFormKopZE As Integer
Dim intFormKopZEleer As Integer
Dim intanzZeilen As Integer
Dim AktWBook As String
Dim strSERVER As String
Dim strHIST As String
Dim strAKTUDAT As String
Dim strAKTUMONAT As String
Dim wbkOrig As Object
Dim wbkTemp As Object
On Error Resume Next
Application.Calculation = xlManual
Application.DisplayAlerts = False
verz = ActiveWorkbook.Path
Set wbkOrig = ThisWorkbook
wbkOrig.Activate
wbkOrig.Worksheets("PARA").Select
Range("A2").Select
strVWS = Cells(ActiveCell.Row, ActiveCell.Column).Value
strSERVER = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value
strHIST = Range("rP1.HIST").Value
strAKTUDAT = Range("rP1.AKTUDAT").Value
strAKTUMONAT = Mid(Range("rP1.AKTUMONAT").Value, 5, 2)
While strVWS <> ""
Workbooks.Open Filename:=verz + "\DATENSAMMLUNG_LEER.xls"
Set wbkTemp = Workbooks("DATENSAMMLUNG_LEER.xls")
'Inhalt OriginalSeite kopieren
wbkOrig.Activate
wbkOrig.Worksheets("Import 1").Select
Selection.AutoFilter Field:=6, Criteria1:=strVWS
If Range("rP1.FilterErgebnis") > 2 Then
Range("rI1.Daten").Select
Selection.Copy
'Inhalt in TempDatei einfügen
wbkTemp.Activate
wbkTemp.Worksheets("Daten 1").Select
Range("D3").Select
ActiveSheet.Paste
'***Formelbereich dynamisch anpassen
Range("rD1.Knoten01").Select
strFormKopSP = "D:D" '***das ist die Leitspalte ohne Formel
intFormKopZE = 3 '***da steht die zu kopierende Formel
intFormKopZEleer = 0 '***Anzahl Leerzeilen über Leitspalte
procFormelnNachUntenFüllen strFormKopSP, intFormKopZE, intFormKopZEleer
Range("rP1.AKTUDAT").Value = strAKTUDAT
' Range("rL1.MonateAusw_2").Value = Val(strAKTUMONAT) - 1
Calculate
Call procUnikate
'***Formelbereich dynamisch anpassen
Range("rF1.Knoten01").Select
strFormKopSP = "J:J" '***das ist die Leitspalte ohne Formel
intFormKopZE = 23 '***da steht die zu kopierende Formel
intFormKopZEleer = 11 '***Anzahl Leerzeilen über Leitspalte
procFormelnNachUntenFüllen strFormKopSP, intFormKopZE, intFormKopZEleer
Application.Calculation = xlAutomatic
'***Spalten in Werte wandeln
Range("rF1.Daten_Namen").Formula = Range("rF1.Daten_Namen").Value
procTabelleSchutz
procTabelleSicherAusblenden
'***jetzt speichern
' Kill strSERVER + "*.xls"
' ActiveWorkbook.SaveAs Filename:=strSERVER + strHIST + ".xls"
ActiveWorkbook.SaveAs Filename:=verz + "\" + strVWS + "_aktuStand" + strHIST + ".xls"
ActiveWorkbook.Close
Application.Calculation = xlManual
'***nächste Einheit
Set wbkTemp = Nothing
wbkOrig.Worksheets("PARA").Select
ActiveCell.Offset(1, 0).Activate
strVWS = Cells(ActiveCell.Row, ActiveCell.Column).Value
strSERVER = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value
Else
'***nächste Einheit
Set wbkTemp = Nothing
wbkOrig.Worksheets("PARA").Select
ActiveCell.Offset(1, 0).Activate
strVWS = Cells(ActiveCell.Row, ActiveCell.Column).Value
strSERVER = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value
End If
Wend
Application.DisplayAlerts = False
End Sub
Nach der Speicherung hat die Einzeldatei z.B. eine Größe von 1.653.760. Wenn ich nun diese Datei manuell öffne und wieder speichere kommt eine Größe von 806.912.Das liegt auch nicht an diesem Ablauf. Das tritt bei allen ähnlichen auf. Gibt es beim ActiveWorkbook.SaveAs noch weitere Parameter die die Größe beieinflussen? Wenn ich das mit dem Recorder aufzeichne, ergeben sich auch keine weiteren Erkenntnisse.
Wo liegt der Fehler im Modul bzw. wie kann man das optimieren?
Gruß Detlef