|
Registriert seit: 27. Okt 2005
1.110 Beiträge
Delphi 10.1 Berlin Enterprise
|
Daten Export nach Excel mit mehr als 66.000 Datensätzen
26. Sep 2006, 15:42
aloha...
ich muss gerade eine text datei nach excel exportieren...
dass programm hab ich schon vor ca. 2 monaten geschrieben und lief bis jetzt wunderbar...
aber jetzt hat die aktuelle text datei über 66.000 datensätze, und excel kann ja maximal
65.536 Datensätze pro tabellenblatt aufnehmen...
ich hab jetzt probiert 1 tabellenblatt zu füllen und nach 65.500 Datensätzen in das
2. tabellenblatt zu wechseln
aber ich bekomm immer folgende fehlermeldung " OLE - Fehler 800A03EC" wenn ich in das
2.tabellenblatt meine daten exportieren will...
hier ist mal meine prozedur:
Delphi-Quellcode:
//******************************************************************************
// Create .xls File and Add all Rows from .txt File *
//******************************************************************************
procedure TMain_Form.prCreateXls(iAnzRec : Integer);
var
bl, blSheets2 : Boolean;
oleExcelApp, oleExcelSheets1, oleExcelSheets2, oleExcelWorkb : OleVariant;
i, iCell, iCount, iRow : Integer;
sDate, sFile, sPath, sRow, sXlsFile : String;
txtFile : TextFile;
wRC : Word;
begin
//Paths
sDate := FormatDateTime('yyyymmdd', Date);
sFile := 'U:\Programmierung\LOG\Router_Tab\Excel\ROUTES_TAB_' + sDate;
sPath := '..\Output\ROUTES_Convert_' + sDate + '.txt';
//Create .xls / Set Column Format / Create Header
oleExcelApp := CreateOleObject('Excel.Application');
oleExcelWorkb := oleExcelApp.Workbooks.Add;
oleExcelSheets1 := oleExcelWorkb.WorkSheets.Add;
oleExcelSheets1.Name := 'Tab (1) vom ' + sDate;
//If more then 65.500 Rows in the DPD Router Tab then Create an Second Sheet
If iAnzRec > 65500 Then
Begin
oleExcelSheets2 := oleExcelWorkb.WorkSheets.Add;
oleExcelSheets2.Name := 'Tab (2) vom ' + sDate;
blSheets2 := True;
End;
iRow := 1;
For i := 1 To 7 Do
Begin
oleExcelSheets1.Columns[i].NumberFormat := '@';
If blSheets2 = True Then
Begin
oleExcelSheets2.Columns[i].NumberFormat := '@';
End;
End;
For i := 1 To 7 Do
Begin
iCell := i;
oleExcelSheets1.Cells[iRow, iCell].Font.FontStyle := 'Bold';
If i = 1 Then oleExcelSheets1.Cells[iRow, iCell].Value := 'Land';
If i = 2 Then oleExcelSheets1.Cells[iRow, iCell].Value := 'PLZ Von';
If i = 3 Then oleExcelSheets1.Cells[iRow, iCell].Value := 'PLZ Bis';
If i = 4 Then oleExcelSheets1.Cells[iRow, iCell].Value := 'O - Sort';
If i = 5 Then oleExcelSheets1.Cells[iRow, iCell].Value := 'D - Depot';
If i = 6 Then oleExcelSheets1.Cells[iRow, iCell].Value := 'D - Sort';
If i = 7 Then oleExcelSheets1.Cells[iRow, iCell].Value := 'Barcoed ID';
If blSheets2 = True Then
Begin
If i = 1 Then oleExcelSheets2.Cells[iRow, iCell].Value := 'Land';
If i = 2 Then oleExcelSheets2.Cells[iRow, iCell].Value := 'PLZ Von';
If i = 3 Then oleExcelSheets2.Cells[iRow, iCell].Value := 'PLZ Bis';
If i = 4 Then oleExcelSheets2.Cells[iRow, iCell].Value := 'O - Sort';
If i = 5 Then oleExcelSheets2.Cells[iRow, iCell].Value := 'D - Depot';
If i = 6 Then oleExcelSheets2.Cells[iRow, iCell].Value := 'D - Sort';
If i = 7 Then oleExcelSheets2.Cells[iRow, iCell].Value := 'Barcoed ID';
End
End;
//Assign .txt File for Input
{$I-}
AssignFile(txtFile, sPath);
Reset(txtFile);
iCount := 100;
iRow := 2;
Application.ProcessMessages;
While Not EOF(txtFile) Do
Begin
Application.ProcessMessages;
Readln(txtFile, sRow);
//Add sRow to Excel Cells
For i := 1 To 7 Do
Begin
iCell := i;
If (iRow < 65501) Then
Begin
If i = 1 Then oleExcelSheets1.Cells[iRow, iCell].Value := Copy(sRow, 1, 2);
If i = 2 Then oleExcelSheets1.Cells[iRow, iCell].Value := Copy(sRow, 3, 9);
If i = 3 Then oleExcelSheets1.Cells[iRow, iCell].Value := Copy(sRow, 12, 9);
If i = 4 Then oleExcelSheets1.Cells[iRow, iCell].Value := Copy(sRow, 21, 4);
If i = 5 Then oleExcelSheets1.Cells[iRow, iCell].Value := Copy(sRow, 25, 4);
If i = 6 Then oleExcelSheets1.Cells[iRow, iCell].Value := Copy(sRow, 29, 4);
If i = 7 Then oleExcelSheets1.Cells[iRow, iCell].Value := Copy(sRow, 33, 3);
End
Else If (iRow >= 65501) Then
Begin
If i = 1 Then oleExcelSheets2.Cells[iRow, iCell].Value := Copy(sRow, 1, 2);
If i = 2 Then oleExcelSheets2.Cells[iRow, iCell].Value := Copy(sRow, 3, 9);
If i = 3 Then oleExcelSheets2.Cells[iRow, iCell].Value := Copy(sRow, 12, 9);
If i = 4 Then oleExcelSheets2.Cells[iRow, iCell].Value := Copy(sRow, 21, 4);
If i = 5 Then oleExcelSheets2.Cells[iRow, iCell].Value := Copy(sRow, 25, 4);
If i = 6 Then oleExcelSheets2.Cells[iRow, iCell].Value := Copy(sRow, 29, 4);
If i = 7 Then oleExcelSheets2.Cells[iRow, iCell].Value := Copy(sRow, 33, 3);
End;
End;
iRow := iRow + 1;
//Set Progress in Pregress Bar
If iRow = iCount Then
Begin
ProgBar2.Position := Round((100 * iRow) / iAnzRec);
iCount := iCount + 100;
End;
End;
CloseFile(txtFile);
{$I-}
//Examine whether File is present
bl := FileExists(sFile + '.xls');
If bl = True Then
Begin
wRC := MessageDlg('Fileis allready present!' +#13+ 'Clear File?', mtINformation, mbYesNo, 0);
If wRC = mrYes Then
Begin
bl := DeleteFile(sFile + '.xls');
If bl = False Then
Begin
ShowMessage('Error with File Clear!');
End;
End
Else
Begin
ShowMessage('File wouls be Overwritten!');
End;
End;
//Save as .xls File
sXlsFile := ChangeFileExt(sFile, '.xls');
Try
oleExcelWorkb.Close(true, sXlsFile, False);
Except
ShowMessage('Save To File Error');
End;
//Excel freigeben
oleExcelSheets1 := Unassigned;
oleExcelSheets2 := Unassigned;
oleExcelWorkb := Unassigned;
oleExcelApp.Quit;
oleExcelApp := Unassigned;
ProgBar2.Position := 0;
lbl_sts_xls.Caption := 'Export to Excel. OK';
lbl_sts_xls.Font.Size := 8;
lbl_sts_xls.Font.Color := clGreen;
Main_Form.Refresh;
bitbtn_exit.Enabled := True;
end;
kann mir hier jemand vielleicht weiterhelfen warum ichs net hinkrieg mein 2. tabellenblatt zu füllen???
bzw. weiß jemand ne andere lösung wie ichs hier versucht hab.....?!
Ein Programmierer Programmiert durchschnittlich 15 Code Zeilen pro Tag
Wir sind hier doch nicht bei SAP!!!
Aber wir habens bald 
|