1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:

procedure ListViewSaveToXLS(AListView: TListView; const sFileName: TFileName);
const
{$J+}
  CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0);
  CXlsEof: array[0..1] of Word = ($0A, 00);
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
{$J-}
var
  idxItem, idxSub: Integer;
  I, Code: Integer;
  ItemCount, SubCount: Word;
  FStream: TFileStream;

  procedure XlsWriteCellNumber(XlsStream: TStream; const ACol, ARow: Word;
    const AValue: Double);
  begin
    CXlsNumber[2] := ARow;
    CXlsNumber[3] := ACol;
    XlsStream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
    XlsStream.WriteBuffer(AValue, 8);
  end;

  procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
    const AValue: string);
  var
    L: Word;
  begin
    L := Length(AValue);
    CXlsLabel[1] := 8 + L;
    CXlsLabel[2] := ARow;
    CXlsLabel[3] := ACol;
    CXlsLabel[5] := L;
    XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
    XlsStream.WriteBuffer(Pointer(AValue)^, L);
  end;

begin
  //Initialization
  FStream := TFileStream.Create(sFileName, fmCreate);
  try
    CXlsBof[4] := 0;
    FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));

    with AListView do
    begin
      if Items.Count = 0 then
        ItemCount := 0
      else
        ItemCount := Items.Count;

      if Items.Count > 0 then
      begin
        for idxItem := 1 to ItemCount do
        begin
          with Items[idxItem - 1] do
          begin
          //Save subitems Count
            if SubItems.Count = 0 then
              SubCount := 0
            else
              SubCount := Subitems.Count;
            Val(Items[idxItem - 1].Caption, I, Code);
            if Code <> 0 then
              XlsWriteCellLabel(FStream, 0, idxItem - 1, Items[idxItem - 1].Caption)
            else
              XlsWriteCellNumber(FStream, 0, idxItem - 1, I);

            if SubCount > 0 then
            begin
              for idxSub := 0 to SubItems.Count - 1 do
              begin
                //Save Item's Subitems
                Val(SubItems[idxSub], I, Code);
                if Code <> 0 then
                  XlsWriteCellLabel(FStream, idxSub + 1, idxItem - 1, SubItems[idxSub])
                else
                  XlsWriteCellNumber(FStream, idxSub + 1, idxItem - 1, I);
              end;
            end;
          end;
        end;
      end;
    end;
    FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
  finally
    FStream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListViewSaveToXLS(ListView1, 'c:\test.xls');
end;