Open xls (password protected) file in Delphi and save data to Firebird table

This can be done through the Component Object Model .

  

The Component Object Model (COM) is a software architecture that allows applications to be built from binary software components. COM is the underlying architecture that forms the basis for high-level software services, such as those provided by OLE . It is used to allow interprocess communication and dynamic object creation in any programming language that supports technology.

OLE Programmatic Identifiers - List of components that can be created by OLE.

In Delphi you can create this type of component through the function CreateOleObject , to use it you must add the unit ComObj in Uses .

To create an Excel application it is necessary to use the identifier Excel.Application .

Going directly to the subject, the function below will open the file, search for a certain value (CNPJ), if it finds the desired value ( Company name ) from the other column of the Company ).

// Inclua em Uses: ComObj;
function GetExcelValue(const xlsPath: string; const CNPJToSeach: string; const Pass: string = ''): string;
const
 xlCellTypeLastCell = $0000000B; // Mais informações em: https://msdn.microsoft.com/en-us/library/office/ff196157.aspx
 ColunaCNPJ    = 1; // Define a coluna aonde será feita a busca pelo CNPJ
 ColunaEmpresa = 2; // Nome da Empresa
var
 ExcelApp, FileName, Password, ReadOnly: Variant;
 Cols, Rows, I, C: Integer;
 RangeMatrix: Variant;
 TempStr: string;
begin
Result := '';
try
  // Cria a aplicação Excel.
  ExcelApp := CreateOleObject('Excel.Application');
  // É especificado o arquivo, a senha, e informamos que esse processo é somente leitura.
  ExcelApp.WorkBooks.Open(FileName := xlsPath, Password := Pass, ReadOnly := True);

  // Ativa a última célula não vazia, necessário para obter o número de linhas e colunas.
  ExcelApp.ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;

  Cols := ExcelApp.ActiveCell.Column; // Número de colunas
  Rows := ExcelApp.ActiveCell.Row;    // Número de Linhas
  // Coloca em RangeMatrix os valores desde A1 até a faixa de colunas e linhas encontradas.
  RangeMatrix := ExcelApp.Range['A1', ExcelApp.Cells.Item[Rows, Cols]].Value;
  I := 1;

  repeat
    for C := 1 to Cols do // Percorre as colunas
      // Verifica se a linha atual correnponde ao CNPJ procurado.
      if RangeMatrix[I, ColunaCNPJ] = CNPJToSeach then begin
        // Se encontrar, obtêm a linha da coluna desejada
        TempStr := VarToStrDef(RangeMatrix[I, ColunaEmpresa], '');
        Break; // Encerra o loop
      end;

      Inc(I, 1);
    until I > Rows;
    Result := TempStr;
finally
  RangeMatrix := Unassigned;
  ExcelApp.Quit;
end;
end;

To use it specify the location of the Excel file, the CNPJ to search, and the password ( optional ).

See an example:

Assuming the worksheet has the following structure:

 ______________________________________________________________________
| CNPJ  | Razão Social | Nome da Empresa | Município | NIRE | Endereço |
|-------+--------------+-----------------+-----------+------+----------|
| 000-1 | Foo          | Empresa-1       | Mun-1     | 1110 | End-1    | 
| 000-2 | Bar          | Empresa-2       | Mun-2     | 2220 | End-2    |
| 000-3 | Baz          | Empresa-3       | Mun-3     | 3330 | End-3    |
 ----------------------------------------------------------------------

And you want to get the name of the company whose CNPJ is 000-2 , to do this call the GetExcelValue function as follows:

procedure TForm1.BtnRetrieveValueClick(Sender: TObject);
const
 EXCELFILEPATH = 'c:\Foo\Bar\ArquivoX.xlsx';
var
 ExcelValue: string;
begin
if FileExists(EXCELFILEPATH) = false then exit;

ExcelValue := GetExcelValue(EXCELFILEPATH, '000-2', 'senha123');

// Fazer algo com o valor obtido daqui em diante.
end;

In situations where you use OLE objects, as is the case on different machines, you may need to verify that the object to be used is available and registered correctly. This avoids problems if Excel, for example, is not installed on the machine, giving you the possibility to do something if this happens. To do this, use the CLSIDFromProgID function. to check.

// Inclua em Uses ActiveX;
function CheckOleObject(Classname: string): Boolean;
var
 ClassID: TCLSID;
begin
if CLSIDFromProgID(pchar(Classname), ClassID) = 0 then
  Result := True
else
  Result := False;
end;

Example usage:

if CheckOleObject('Excel.Application') = false then
  // Fazer algo aqui caso o Excel não esteja disponível

Regarding the insertion of this value into a table with Firebird , I am going to be given more details about, however, one of the possible ways to this is INSERT .

Example ( not tested ) with IBQuery : p>

IBQuery1.close;
IBQuery1.sql.Clear;
IBQuery1.SQL.Add('INSERT INTO Tabela1 ');
IBQuery1.SQL.Add('(CNPJ, EMPRESA)');
IBQuery1.SQL.Add('VALUES');
IBQuery1.SQL.Add('(:CNPJ, :EMPRESA)');

IBQuery1.ParamByName('EMPRESA').AsString := ''; // Aqui você coloca o nome da empresa
IBQuery1.ParamByName('CNPJ').AsString := '';    // Aqui o CNPJ da empresa

IBQuery1.ExecSQL;

I'm not very knowledgeable about Object Pascal or Delphi, but I'll try to provide a reasonable answer.

Security with the original file

The reason for this is to prevent two applications from accessing the same file, Excel creates a LOCK in the file and this generates some locks and even when it is not in LOCK >, there may be conflicts if your software is running XLS at the same time as Excel is clicked on Ctrl + B .

In order to avoid conflicts the best way is to generate a copy of the file, for this I used this function (source: link ):

function GetTempFile(const Extension: string): string;
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  repeat
    GetTempPath(SizeOf(Buffer) - 1, Buffer);
    GetTempFileName(Buffer, '~', 0, Buffer);
    Result := ChangeFileExt(Buffer, Extension);
  until not FileExists(Result);
end;

Selecting the XLS file

In the case I chose to select both XLS and XLSX, as I believe it is more likely to use the latest format (especially if it is a software for Windows), in this way, it is possible to support both formats (depending on the version installed from Excel):

var
  selectedFile: String;

PromptForFileName(selectedFile, 'Documento do Excel (*.xls, *.xlsx)|*.xls; *.xlsx', '', 'Selecione...', 'C:\', False)

Reading the XLS file

I created a function to read (with password and no password) combined with the function GetTempFile , it returns Boolean and the parameter var handler returns the file opened. To open a file without a password do something like openExcel(handler; 'arquivo.xls'; ''); , with password openExcel(handler; 'arquivo.xls'; 'senha');

function openExcel(var handler: Variant; selectedFile: String; pass: String): Boolean;
begin
  EndExcel();

  tmpFile := GetTempFile('.~tp');

  CopyFile(pchar(selectedFile), pchar(tmpFile), true);

  xlsExcel := CreateOLEObject('Excel.Application');
  xlsExcel.Visible := False;

  try
    handler := xlsExcel.WorkBooks.Open(selectedFile, Password := password, ReadOnly := True);
    Result := True;
  except
    showmessage('excepet');
    EndExcel();
    handler := Unassigned;
    Result := False;
  end;
end;

Closing the XLS

Note that the EXCEL.EXE process does not end, even if you close the application, because it is a ActiveX , ie it runs separately, so I created a function called EndExcel to finish whenever necessary and clean the variable.

procedure EndExcel();
begin
  if VarIsEmpty(xlsExcel) = False then
  begin
    xlsExcel.Quit;
    xlsExcel := Unassigned;
  end;

  if tmpFile <> '' then
  begin
    DeleteFile(tmpFile);
  end;
end;

Authenticating the XLS

Authentication will sometimes be necessary and is a requirement that you mentioned, for this I created an event that works in combination with openExcel , to call it just run authExcel('arquivo.xls'); . It will open prompt to select a file, the function itself will test if a password is needed, if it is necessary then a prompt will appear asking you to enter the password, follow the function:

function authExcel(fileStr: String) : Variant;
var
  password: String;
  buttonSelected: Integer;
  xlsTmp: Variant;
begin
  password := InputBox('Autenticação', 'Senha do arquivo', '');
  if password = '' then
  begin
      ShowMessage('Nenhuma senha digitada');
      Result := Unassigned;
  end
  else            
  begin
    if openExcel(xlsTmp, fileStr, password) then
    begin
      Result := xlsTmp
    end
    else
    begin
      buttonSelected := MessageDlg('Senha inválida, tentar novamente?', mtCustom, [mbYes, mbCancel], 0);
      if buttonSelected = mrYes then
      begin
        Result := authExcel(fileStr);
      end
      else
      begin
        ShowMessage('Cancelado');
        Result := Unassigned;
      end;
    end;
  end;
end;

Searching in the first column

I would make a array that would bring all results, but I chose to create function with search by "wildcard" (if necessary) or by keyword, this search is done in the column you want, but as the case is search in the first one then I added a parameter to change as needed, this function returns a multidimensional array of this type array of array of string

The function looks like this:

findInExcel(xls: Variant; col: Integer; query: String; limitCols: Integer): TStringArrayArray

col refers to the column you want to query, query will be the search and limitCols is to avoid copying extra columns to the right, also note that after using findInExcel I used EndExcel() , however remove this part if you still need handler (xls: Variant), use examples below:

findInExcel(handler, 1, 'a', 0);
EndExcel();

findInExcel(handler, 1, '*', 4);
EndExcel();

findInExcel(handler, 2, 'A*', 5);
EndExcel();

findInExcel(handler, 1, '*B', 0);
EndExcel();

How to configure the file pas :

• Add to uses ComObj and StrUtils for functions to work
• Add to type this TStringArrayArray = Array of Array of String;
• Add the global variables xlsExcel: Variant; and tmpFile: String;

Usage example (tested in Delphi7):

I'm not going to talk about FireBird because I do not know what your structure / modeling is, so I'm going to assume that the problem is getting the Excel data only.

In the example each time a loop is looped in the first for an Excel row is returned, and every time a loop is looped in the second for a column is returned:

  for i := 0 to High(encontrados) do
  begin
    for j := 0 to High(encontrados[i]) do
    begin
  if encontrados[i][j] <> '' then //Evita dados em branco
    ShowMessage('Linha: ' + IntToStr(i) + ' - Coluna: ' + IntToStr(j) + ' = ' + encontrados[i][j]);
    end;
  end;

For an xls file like this:

+----+----+----+----+
| a1 | a2 | a3 | a4 |
+----+----+----+----+
| b1 | b2 | b3 | b4 |
+----+----+----+----+

The example will return this (note that in arrays numbers always start from 0 , if you need to solve this in your database just add +1 ):

  

Line: 0 - Column: 0 = a1

     

Line: 0 - Column: 1 = a2

     

Line: 0 - Column: 2 = a3

     

Line: 0 - Column: 3 = a4

     

Line: 1 - Column: 0 = b1

     

Line: 1 - Column: 1 = b2

     

Line: 1 - Column: 2 = b3

     

Line: 1 - Column: 3 = b4

Complete example:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj, StrUtils;

type
  TStringArrayArray = Array of Array of String;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  tmpFile: String;
  selectedFile: String;
  password: String; 
  xlsExcel: Variant;
  xlsDocument: Variant;
  consultarEm: Integer;
  encontrados: TStringArrayArray;

implementation

{$R *.dfm}

procedure EndExcel();
begin
  if VarIsEmpty(xlsExcel) = False then
  begin
    xlsExcel.Quit;
    xlsExcel := Unassigned;
  end;

  if tmpFile <> '' then
  begin
    DeleteFile(tmpFile);
  end;
end;

function GetTempFile(const Extension: String): String;
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  repeat
    GetTempPath(SizeOf(Buffer) - 1, Buffer);
    GetTempFileName(Buffer, '~', 0, Buffer);
    Result := ChangeFileExt(Buffer, Extension);
  until not FileExists(Result);
end;

function openExcel(var handler: Variant; selectedFile: String; pass: String): Boolean;
begin
  EndExcel();

  tmpFile := GetTempFile('.~tp');

  CopyFile(pchar(selectedFile), pchar(tmpFile), true);

  xlsExcel := CreateOLEObject('Excel.Application');
  xlsExcel.Visible := False;

  try
    handler := xlsExcel.WorkBooks.Open(selectedFile, Password := password, ReadOnly := True);
    Result := True;
  except
    showmessage('excepet');
    EndExcel();
    handler := Unassigned;
    Result := False;
  end;
end;

function authExcel(fileStr: String) : Variant;
var
  password: String;
  buttonSelected: Integer;
  xlsTmp: Variant;
begin
  password := InputBox('Autenticação', 'Senha do arquivo', '');
  if password = '' then
  begin
      ShowMessage('Nenhuma senha digitada');
      Result := Unassigned;
  end
  else            
  begin
    if openExcel(xlsTmp, fileStr, password) then
    begin
      Result := xlsTmp
    end
    else
    begin
      buttonSelected := MessageDlg('Senha inválida, tentar novamente?', mtCustom, [mbYes, mbCancel], 0);
      if buttonSelected = mrYes then
      begin
        Result := authExcel(fileStr);
      end
      else
      begin
        ShowMessage('Cancelado');
        Result := Unassigned;
      end;
    end;
  end;
end;

function findInExcel(xls: Variant; col: Integer; query: String; limitCols: Integer) : TStringArrayArray;
var
  pages: Integer;
  currentPage: Integer;
  currentLine: Integer;
  currentCol: Integer;
  found: Integer;
  lines: Integer;
  cols: Integer;
  cells: Integer;
  dataRow: String;
  resultados: TStringArrayArray;
  coringa: Boolean;
  coringaReverse: Boolean;
  findAll: Boolean;
begin
  if col < 1 then
  begin
    ShowMessage('Coluna para consulta não especificada');
    Result := null;
  end
  else
  begin
    pages := xls.Worksheets.Count;
    if pages > 0 then
    begin
      cells := 0;
      found := 0;
      cols  := 0;
      currentPage := 0;

      findAll := '*' = query;
      coringa := AnsiPos('*', query) > 0;
      coringaReverse := AnsiPos('*', query) = 1;

      query := StringReplace(query, '*', '', [rfReplaceAll, rfIgnoreCase]);

      while currentPage < pages do
      begin
        currentLine := 0;
        lines := xls.Worksheets[currentPage + 1].UsedRange.Rows.Count;
        while currentLine < lines do
        begin
          dataRow := xls.Worksheets[currentPage + 1].Cells[currentLine + 1, col];

          if coringaReverse then
            dataRow := ReverseString(dataRow);

          if (findAll and (dataRow <> '')) or (coringa and (AnsiPos(query, dataRow) = 1)) or (dataRow = query) then
          begin
            cells := xls.Worksheets[currentPage + 1].UsedRange.Cells.Count;
            found := found + 1;

            if cols < cells then
              cols := cells;

            if (limitCols > 0) and (cells > limitCols) then
              cols := limitCols;

            if cells > 0 then
              SetLength(resultados, found, cols);

            currentCol := 0;

            while (currentCol < cols) and (cells > 0) do
            begin
             dataRow := xls.Worksheets[currentPage + 1].Cells[currentLine + 1, currentCol + 1];
             resultados[found - 1][currentCol] := xls.Worksheets[currentPage + 1].Cells[currentLine + 1, currentCol + 1];
             currentCol := currentCol + 1;
            end;
          end;
          currentLine := currentLine + 1;
        end;
        currentPage := currentPage + 1;
      end;
      Result := resultados;
    end
    else
    begin
      ShowMessage('Não há páginas neste documento');
    end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  EndExcel();

  //Remova esta parte se quiser
  if MessageDlg('Deseja realmente sair?', mtCustom, [mbYes, mbCancel], 0) = mrCancel then
    Action := caNone;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  j: Integer;
begin
  if PromptForFileName(selectedFile, 'Documento do Excel (*.xls, *.xlsx)|*.xls; *.xlsx', '', 'Selecione...', 'C:\', False) then
  begin
    if openExcel(xlsDocument, selectedFile, '') = False then
      xlsDocument := authExcel(selectedFile);

    if VarIsEmpty(xlsDocument) = False then
    begin
      consultarEm := StrToInt(InputBox('Infomarção', 'Qual coluna gostaria de consultar', '1'));
      if consultarEm > 0 then
      begin
        encontrados := findInExcel(xlsDocument, consultarEm, '*', 4);
        EndExcel();

        if High(encontrados) = -1 then
        begin
          ShowMessage('Não foram encontrados resultados');
        end
        else
        begin
              for i := 0 to High(encontrados) do
              begin
                for j := 0 to High(encontrados[i]) do
                begin
              if encontrados[i][j] <> '' then //Evita dados em branco
                ShowMessage('Linha: ' + IntToStr(i) + ' - Coluna: ' + IntToStr(j) + ': ' + encontrados[i][j]);
                end;
              end;
        end;
      end
      else
      begin
        ShowMessage('Coluna inválida');
      end;
    end;
  end
  else            
  begin
      ShowMessage('Nenhum arquivo selecionado');
  end;
end;

end.