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

Question

I have an office file (.xls), password protected, which has several lines.

I want to search the contents of the column 1 and knowing the row that the result is found I want to save this single row in a table of the Firebird database.

Example:

Let’s say the table is company data. In case I would like to know the name of the company and have the CNPJ of it. Therefore, I will use a for (believe) and run on all lines until you find the CNPJ that I informed, and after that I will get the contents of the field Social Reason.

Answer 1

This can be done through architecture 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 enable communication between processes and the dynamic creation of objects in any programming language that supports technology.

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

In Delphi it is possible to create this type of component through the function CreateOleObject, to use it it is necessary to include the unit Like in Uses.

To create an Excel application you need to use the identifier Excel.Application.

Going straight to the subject, the function below will open the file, search for a certain value (CNPJ), if it finds takes the desired value (Social reason) of the other column (Company Name).

// 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 for, and the password (optional).

Take an example:

Assuming the spreadsheet 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 function GetExcelValue 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. For this use the function CLSIDFromProgID to verify.

// 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 of use:

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

Regarding the insertion of this value in a table with Firebird, I’m going to owe you more details on, however, one of the possible ways to do this is the INSERT.

Example (untested) with Ibquery:

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;

Answer 2

I don’t know much about Object Pascal or Delphi, but I will try to provide a reasonable response.

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 causes some locks and even when it is not with the LOCK, there may be conflict if your software is working the XLS at the same time as in Excel is clicked Ctrl+B (Save).

To avoid conflicts the best way is to generate a copy of the file, for this I used this function (source: http://www.swissdelphicenter.ch/torry/showcode.php?id=385):

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 case I chose to select both XLS and XLSX, because I believe it is more likely to use the latest format (mainly if it is a software for Windows), this way it is possible to give support for both formats (depending on the installed version of Excel):

var
  selectedFile: String;

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

Reading the XLS file

I created a reading function (with password and no password) combined with the function GetTempFile, she returns Boolean and the parameter var handler returns the file opened. To open a file without password do something like openExcel(handler; 'arquivo.xls'; '');, password-protected 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 process EXCEL.EXE does not end, even if it closes the application, because it is a ActiveX, ie it runs separately, for this I created a function called EndExcel to finish is always 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 you mentioned, for this I created an event that works combined with the openExcel, to call it just run authExcel('arquivo.xls');. Will open a prompt to select a file, the function itself will test if password is needed, if it is necessary then a prompt will appear asking to enter such password, follows 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 was gonna make a array that would bring all results, but I chose to create function with search for "joker" (if necessary) or by keyword, this search is done in the column you want, but as the case is to search in the first 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 is like this:

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

col refers to the column you wish to view, query will be the research and limitCols is to avoid copying extra columns right, note also that after using findInExcel used the EndExcel(), but remove this part if you still need the handler (xls: Variant), following examples of use:

1. Search in the first column, containing the word a and no right column limit (the function itself will try to limit):

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

2. Search in the first column, which contains anything (the function will try to avoid empty columns) and with limit of 4 columns to the right:

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

3. Search in the second column, starting with the letter A (for example A0001, A0002) and with a limit of 5 columns to the right:

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

4. Search in the first column, ending with the letter B (for example 0001B, 2B) and no right column limit (the function itself will try to limit):

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

How to configure the file pas:

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

Example of use (tested in Delphi7):

I’m not going to talk about Firebird, because I don’t know what its structure/ modeling looks like, so I’m going to assume that the problem is getting the Excel data only.

In the example each time a loop is made in the first for is returned one Excel row and each time a loop is made 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 the numbers always start from 0, if you need to resolve this in your database just add +1):

Row: 0 - Column: 0 = a1

Row: 0 - Column: 1 = a2

Row: 0 - Column: 2 = A3

Row: 0 - Column: 3 = A4

Row: 1 - Column: 0 = B1

Row: 1 - Column: 1 = B2

Row: 1 - Column: 2 = B3

Row: 1 - Column: 3 = B4

Full 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.