Exporting Excel files to HTML (Delphi)

Note

This demo is available in your FlexCel installation at <FlexCel Install Folder>\Demo\Delphi\Modules\25.Printing and Exporting\40.Export HTML and also at https:​//​github.​com/​tmssoftware/​TMS-​FlexCel.​VCL-​demos/​tree/​master/​Delphi/​Modules/​25.​Printing and Exporting/40.Export HTML

Overview

FlexCel can natively export an Excel file to HTML, in many formats like XHTML 1.1, HTML 3.2, HTML 4.1 strict or HTML 5.

Concepts

• HTML is a format that makes emphasis in semantics over presentation, and because of this reason the HTML file will not be as faithful to the original file as a PDF. PDF are targeted especially for handling presentation. Anyway, the output is very similar and in many ways better (and more cross-browser) than the HTML generated by Excel itself when saving to HTML.

• Among the things that are not exported you can find:

• ActiveX objects

• 3D Charts (They will be rendered as 2d)

• Not common AutoShapes (most used Autoshapes, as rectangles, rounded rectangles, ellipses, etc are exported)

Files

UExportHTML.pas

unit UExportHTML;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ImgList, ActnList, StdCtrls,
  Tabs, Grids,ExtCtrls, ComCtrls, ToolWin,
  {$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
  ShellAPI, UMailDialog,
  FlexCel.VCLSupport, FlexCel.Core, FlexCel.XlsAdapter, FlexCel.Render;

type
  TFExportHTML = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton6: TToolButton;
    Actions: TActionList;
    ActionOpen: TAction;
    ActionExportAsHTML: TAction;
    ActionExportAsMHTML: TAction;
    ActionClose: TAction;
    OpenDialog: TOpenDialog;
    ToolbarImages: TImageList;
    ToolButton5: TToolButton;
    Panel1: TPanel;
    Label1: TLabel;
    cbExportObject: TComboBox;
    cbSheet: TComboBox;
    Label2: TLabel;
    Panel2: TPanel;
    Label3: TLabel;
    chGridLines: TCheckBox;
    chPrintHeadings: TCheckBox;
    Panel3: TPanel;
    Label4: TLabel;
    cbImages: TCheckBox;
    cbComments: TCheckBox;
    cbHyperlinks: TCheckBox;
    cbHeadersFooters: TCheckBox;
    Panel4: TPanel;
    Label5: TLabel;
    cbOutlook2007: TCheckBox;
    cbIe6Png: TCheckBox;
    Panel5: TPanel;
    Label6: TLabel;
    cbLeft: TCheckBox;
    cbTop: TCheckBox;
    cbRight: TCheckBox;
    cbBottom: TCheckBox;
    Panel6: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    cbHtmlVersion: TComboBox;
    cbFileFormat: TComboBox;
    Panel7: TPanel;
    Label9: TLabel;
    edTop: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    edBottom: TEdit;
    Label12: TLabel;
    edLeft: TEdit;
    edRight: TEdit;
    Label13: TLabel;
    Label14: TLabel;
    Panel8: TPanel;
    Label15: TLabel;
    edSheetSeparator: TEdit;
    Panel9: TPanel;
    Label16: TLabel;
    edBodyStart: TEdit;
    Panel10: TPanel;
    Label17: TLabel;
    edImages: TEdit;
    Panel11: TPanel;
    edCss: TEdit;
    cbCss: TCheckBox;
    cbReplaceFonts: TCheckBox;
    chFormulaText: TCheckBox;
    ExportDialog: TSaveDialog;
    sbSVG: TCheckBox;
    Label18: TLabel;
    cbEmbedImages: TCheckBox;
    ToolbarImages_100Scale: TImageList;
    ToolbarImages_300Scale: TImageList;
    procedure ActionCloseExecute(Sender: TObject);
    procedure ActionOpenExecute(Sender: TObject);
    procedure cbSheetChange(Sender: TObject);
    procedure ActionExportAsHTMLExecute(Sender: TObject);
    procedure cbExportObjectChange(Sender: TObject);
    procedure cbCssClick(Sender: TObject);
    procedure ActionExportAsMHTMLExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    Html: TFlexCelHtmlExport;
    procedure LoadSheetConfig;
    function HasFileOpen: Boolean;
    function LoadPreferences: Boolean;
    procedure HtmlFont(const sender: TObject; const e: THtmlFontEventArgs);
    function GenerateMHTML: string;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    { Public declarations }
  end;

var
  FExportHTML: TFExportHTML;

implementation
uses IOUtils, UFlexCelHDPI;

{$R *.dfm}

constructor TFExportHTML.Create(aOwner: TComponent);
begin
  inherited;
  Html := TFlexCelHtmlExport.Create;
  Html.AllowOverwritingFiles := true;
  Html.HtmlFont := HtmlFont;
end;

destructor TFExportHTML.Destroy;
begin
  Html.Workbook.Free;
  FreeAndNil(Html);
  inherited;
end;

procedure TFExportHTML.FormCreate(Sender: TObject);
begin
  RegisterForHDPI(Self, nil);
end;

procedure TFExportHTML.HtmlFont(const sender: TObject; const e: THtmlFontEventArgs);
begin
  if cbReplaceFonts.Checked then
  begin
    e.FontFamily := 'arial, sans-serif';
  end;
end;


procedure TFExportHTML.ActionCloseExecute(Sender: TObject);
begin
  Close;
end;

procedure TFExportHTML.ActionExportAsHTMLExecute(Sender: TObject);
var
  CssFileName: String;
  FileNameToOpen: String;
  SelectorPosition: TSheetSelectorPositionSet;
  GeneratedFiles: TArray<String>;
begin
  if not HasFileOpen then
    exit;

  if not LoadPreferences then
    exit;

  if cbFileFormat.ItemIndex = 1 then
  begin
    Html.HtmlFileFormat := THtmlFileFormat.MHtml;
    ExportDialog.FilterIndex := 2;
  end else
  begin
    Html.HtmlFileFormat := THtmlFileFormat.Html;
    ExportDialog.FilterIndex := 1;
  end;

  if not ExportDialog.Execute then exit;

  Html.AllowOverwritingFiles := true;
  Html.SavedImagesFormat := THtmlImageFormat.Png;
  CssFileName := '';
  if cbCss.Checked then
    CssFileName := edCss.Text;

  FileNameToOpen := ExportDialog.FileName;

  case cbHtmlVersion.ItemIndex of
    0: Html.HtmlVersion := THtmlVersion.Html_32;
    2: Html.HtmlVersion := THtmlVersion.XHTML_10;
    3: Html.HtmlVersion := THtmlVersion.Html_5;
    else Html.HtmlVersion := THtmlVersion.Html_401;
  end;

  if edBodyStart.Text <> '' then
    Html.ExtraInfo.BodyStart := TArray<String>.Create(edBodyStart.Text);

  case cbExportObject.ItemIndex of
    0:
    begin
      SelectorPosition := [];
      if cbTop.Checked then
        SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Top];

      if cbLeft.Checked then
        SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Left];

      if cbBottom.Checked then
        SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Bottom];

      if cbRight.Checked then
        SelectorPosition:= SelectorPosition + [TSheetSelectorPosition.Right];

      Html.ExportAllVisibleSheetsAsTabs(TPath.GetDirectoryName(ExportDialog.FileName),
        TPath.GetFileNameWithoutExtension(ExportDialog.FileName),
        TPath.GetExtension(ExportDialog.FileName),
        edImages.Text, CssFileName, TStandardSheetSelector.Create(SelectorPosition), true);

      FileNameToOpen := TPath.Combine(TPath.GetDirectoryName(ExportDialog.FileName), TPath.GetFileNameWithoutExtension(ExportDialog.FileName));
      FileNameToOpen := TPath.Combine(FileNameToOpen, Html.Workbook.SheetName);
      FileNameToOpen := TPath.Combine(FileNameToOpen, TPath.GetExtension(ExportDialog.FileName));
    end;
    1:
    begin
      Html.ExportAllVisibleSheetsAsOneHtmlFile(ExportDialog.FileName, edImages.Text, CssFileName, edSheetSeparator.Text);
    end;
    2:
    begin
      begin
        Html.Export(ExportDialog.FileName, edImages.Text, CssFileName);
      end;
    end;
  end;
  GeneratedFiles := Html.GeneratedFiles.GetHtmlFiles;
  if Length(GeneratedFiles) = 0 then
  begin
    ShowMessage('Error: No file has been generated');
  end else
  begin
    if MessageDlg('Do you want to open the generated file?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      ShellExecute(0, 'open', PCHAR(GeneratedFiles[0]), nil, nil, SW_SHOWNORMAL);
    end;

  end;

end;

procedure TFExportHTML.ActionExportAsMHTMLExecute(Sender: TObject);
var
  dr: TModalResult;
begin
  if not HasFileOpen then
    exit;

  if not Html.FixOutlook2007CssSupport then
  begin
    dr := MessageDlg('You have not checked "Outlook 2007 support". If any of your clients has Outlook express, you should turn this on.'#$000A#$000A'Use Outlook 2007 fix?',
         TMsgDlgType.mtWarning, [mbYes, mbNo, mbCancel], 0);
    if dr = mrCancel then
      exit;

    if dr = mrYes then
    begin
      cbOutlook2007.Checked := true;
      Html.FixOutlook2007CssSupport := true;
    end;

  end;

  MailDialog.GetMHTML := GenerateMHTML;
  MailDialog.ShowModal;
end;

procedure TFExportHTML.ActionOpenExecute(Sender: TObject);
var
  Xls: TExcelFile;
  i: Int32;
begin
  if not OpenDialog.Execute then exit;

  if Html.Workbook = nil then Html.Workbook := TXlsFile.Create;
  Html.Workbook.Open(OpenDialog.FileName);
  Caption := 'Export: ' + OpenDialog.FileName;
  Xls := Html.Workbook;
  cbSheet.Items.Clear;
  for i := 1 to Xls.SheetCount do
  begin
    cbSheet.Items.Add(Xls.GetSheetName(i));
  end;

  cbSheet.ItemIndex := Xls.ActiveSheet - 1;
  LoadSheetConfig;
end;

procedure TFExportHTML.cbCssClick(Sender: TObject);
begin
  edCss.Enabled := cbCss.Checked;
end;

procedure TFExportHTML.cbExportObjectChange(Sender: TObject);
begin
  edSheetSeparator.Enabled := cbExportObject.ItemIndex = 1;
  cbTop.Enabled := cbExportObject.ItemIndex = 0;
  cbLeft.Enabled := cbExportObject.ItemIndex = 0;
  cbRight.Enabled := cbExportObject.ItemIndex = 0;
  cbBottom.Enabled := cbExportObject.ItemIndex = 0;
  cbSheet.Enabled := cbExportObject.ItemIndex = 2;
end;

procedure TFExportHTML.cbSheetChange(Sender: TObject);
begin
  Html.Workbook.ActiveSheet := cbSheet.ItemIndex + 1;
  LoadSheetConfig;
end;

procedure TFExportHTML.LoadSheetConfig;
var
  Xls: TExcelFile;
begin
  Xls := Html.Workbook;
  chGridLines.Checked := Xls.PrintGridLines;
  chPrintHeadings.Checked := Xls.PrintHeadings;
  chFormulaText.Checked := Xls.ShowFormulaText;
end;

function TFExportHTML.HasFileOpen: Boolean;
begin
  if Html.Workbook = nil then
  begin
    ShowMessage('You need to open a file first.');
    exit(false);
  end;

  Result := true;
end;

function TFExportHTML.LoadPreferences: Boolean;
var
  Xls: TExcelFile;
begin
  //NOTE: THERE SHOULD BE *A LOT* MORE VALIDATION OF VALUES ON THIS METHOD.
  //(For example, validate that margins are between bounds)
  // As this is a simple demo, they are not included.
  try
    Xls := Html.Workbook;

     //Note: In this demo we will only apply this things to the active sheet.
     //If you want to apply the settings to all the sheets, you should loop in the sheets and change them here.
    Xls.PrintGridLines := chGridLines.Checked;
    Xls.PrintHeadings := chPrintHeadings.Checked;
    Xls.ShowFormulaText := chFormulaText.Checked;
    Html.PrintRangeLeft := StrToInt(edLeft.Text);
    Html.PrintRangeTop := StrToInt(edTop.Text);
    Html.PrintRangeRight := StrToInt(edRight.Text);
    Html.PrintRangeBottom := StrToInt(edBottom.Text);

    if (sbSVG.Checked) then Html.SavedImagesFormat := THtmlImageFormat.Svg else Html.SavedImagesFormat := THtmlImageFormat.Png;
    Html.EmbedImages := cbEmbedImages.Checked;

    Html.FixOutlook2007CssSupport := cbOutlook2007.Checked;
    Html.FixIE6TransparentPngSupport := cbIe6Png.Checked;
    Html.HidePrintObjects := [];
    if not cbImages.Checked then
      Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Images];

    if not cbHyperlinks.Checked then
      Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Hyperlynks];

    if not cbComments.Checked then
      Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Comments];

    if not cbHeadersFooters.Checked then
      Html.HidePrintObjects:= Html.HidePrintObjects + [THidePrintObjects.Headers, THidePrintObjects.Footers];

  except
    on e: Exception do
      begin
        ShowMessage('Error: ' + e.Message);
        exit(false);
      end;
  end;
  Result := true;
end;

function TFExportHTML.GenerateMHTML: string;
var
  ms: TBytesStream;
  writer: TStreamWriter;
  preambleLen: integer;
begin
  LoadPreferences;
  Html.HtmlFileFormat := THtmlFileFormat.MHtml;
  Html.AllowOverwritingFiles := true;
  Html.SavedImagesFormat := THtmlImageFormat.Png;
  Html.HtmlVersion := THtmlVersion.Html_401;
  if edBodyStart.Text <> '' then
    Html.ExtraInfo.BodyStart := TArray<String>.Create(edBodyStart.Text);

  ms := TBytesStream.Create;
  try
    writer := TStreamWriter.Create(ms, TEncoding.UTF8);
    try
      Html.Export(writer, Html.Workbook.ActiveFileName, nil);
    finally
      FreeAndNil(writer);
    end;
    PreambleLen := Length(TEncoding.UTF8.GetPreamble);
    exit(TEncoding.UTF8.GetString(ms.Bytes, preambleLen, ms.Size - preambleLen));
  finally
    FreeAndNil(ms);
  end;
end;


end.

UMailDialog.pas

unit UMailDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase, IdSMTP, IdMessage,
  {$if CompilerVersion >= 23.0} System.UITypes, {$IFEND}
  IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, StrUtils;

type
  TMailDialog = class(TForm)
    edFrom: TLabeledEdit;
    edTo: TLabeledEdit;
    edSubject: TLabeledEdit;
    edOutServer: TLabeledEdit;
    btnSend: TButton;
    btnCancel: TButton;
    Mailer: TIdSMTP;
    Msg: TIdMessage;
    edPort: TLabeledEdit;
    edUserName: TLabeledEdit;
    edPassword: TLabeledEdit;
    cbUseTLS: TCheckBox;
    SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
    procedure btnSendClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edFromExit(Sender: TObject);
    procedure cbUseTLSClick(Sender: TObject);
  private
    OriginalTo, OriginalFrom, OriginalServer: string;
    function ValidateFields: Boolean;
    procedure FillServer;
    procedure FillMsgBody;
    { Private declarations }
  public
    GetMHTML: TFunc<string>;
    { Public declarations }
  end;

var
  MailDialog: TMailDialog;

implementation

{$R *.dfm}

procedure TMailDialog.cbUseTLSClick(Sender: TObject);
begin
  edPort.Visible := cbUseTLS.Checked;
  edUserName.Visible := cbUseTLS.Checked;
  edPassword.Visible := cbUseTLS.Checked;
end;

procedure TMailDialog.edFromExit(Sender: TObject);
begin
 if (OriginalTo = edTo.Text) and (OriginalFrom <> edFrom.Text) then
  begin
    edTo.Text := edFrom.Text;
  end;

  FillServer;
  if edUserName.Text = '' then edUserName.Text := edFrom.Text;

end;

procedure TMailDialog.FillServer;
var
  AtPos: Int32;
  Server: String;
begin
  if (OriginalServer = edOutServer.Text) and (OriginalFrom <> edFrom.Text) then
  begin
    AtPos := Pos('@', edFrom.Text);
    if AtPos > 1 then
    begin
      Server := copy(edFrom.Text, AtPos + 1, Length(edFrom.Text));
      edOutServer.Text := 'smtp.' + Server;
    end;

  end;

end;

procedure TMailDialog.FormCreate(Sender: TObject);
begin
  OriginalTo := edTo.Text;
  OriginalFrom := edFrom.Text;
  OriginalServer := edOutServer.Text;
end;

function TMailDialog.ValidateFields: Boolean;
begin
  if OriginalFrom = edFrom.Text then
  begin
    ShowMessage('Please change the ''From'' field to the user you are using to send the email');
    edFrom.SetFocus;
    exit(false);
  end;

  if OriginalTo = edTo.Text then
  begin
    ShowMessage('Please change the ''TO'' field to the user you want to send the email');
    edTo.SetFocus;
    exit(false);
  end;

  if OriginalServer = edOutServer.Text then
  begin
    ShowMessage('Please change the ''Outgoing Mail Server'' field to the pop3 server you will use to send the email.');
    edOutServer.SetFocus;
    exit(false);
  end;

  Result := true;
end;

procedure TMailDialog.FillMsgBody;
var
  p, p0: integer;
  s: string;
begin
  //FlexCel returns both headers and body, as this is the MHTML standard. We need to separate
  //them to add headers to headers and body to body. Maybe other smtp component different from
  //indy could allow to just write the raw block.

  s := GetMHTML;
  p0 := 1;

  while true do
  begin
    p := PosEx(#13#10, s, p0);
    if (p < 1) or(p >= Length(s) - 3) then exit;
    Msg.Headers.Add(Copy(s, p0, p - p0));
    p0 := p + 2;
    if s[p0] = #13 then break; //double enter.
  end;

  Msg.Body.Text := copy(s, p0 + 2, Length(s));

end;

procedure TMailDialog.btnSendClick(Sender: TObject);
begin
 if not ValidateFields then
    exit;

  if MessageDlg('Now we will try to send the email using the server ''' + edOutServer.Text +
     ''''#$000A + 'Note that this is a very simple implementation, and it might not work if the SMTP server needs to login. GMail accounts should work.',
     mtInformation,
     [mbOk, mbCancel], 0) <> mrOK then exit;

  Msg.Clear;
  Msg.NoEncode := true;
  Msg.Headers.Add('From: ' +  Trim(edFrom.Text));
  Msg.Recipients.Add.Text := Trim(edTo.Text);
  Msg.Headers.Add('Subject: ' + Trim(edSubject.Text));

  FillMsgBody;
  Mailer.Host := Trim(edOutServer.Text);
  if cbUseTLS.Checked then
  begin
    Mailer.Port := StrToInt(Trim(edPort.Text));
    Mailer.Username := Trim(edUserName.Text);
    Mailer.Password := Trim(edPassword.Text);
    Mailer.UseTLS := TIdUseTLS.utUseExplicitTLS;
  end
  else
  begin
    Mailer.Port := 25;
    Mailer.Username := '';
    Mailer.Password := '';
    Mailer.UseTLS := TIdUseTLS.utNoTLSSupport;
  end;


  try
    Mailer.Connect;
    try
      Mailer.Send(Msg);
    finally
      Mailer.Disconnect;
    end;
  except
    on ex: Exception do
      begin
        ShowMessage('Error trying to send the message: ' + ex.Message);
        exit;
      end;
  end;
  ShowMessage('Message has been sent. Please verify your JUNK folder or any filters, since it might be filtered as spam');
  ModalResult := mrOk;
end;

end.