Threaded Excel File Processing in Delphi

Question

I created a TThread to handle some critical issues in an Excel file, however, I'm currently experiencing some challenges as the thread doesn't seem to be working in parallel with my application. Despite my best efforts to identify the root cause of the issue, I have been unsuccessful thus far. In an attempt to resolve the problem, I have experimented with defining a TThread Type with an overridden Execute method and also attempted to switch from Synchronize to Queue methods, but neither approach has yielded positive results so far.

procedure TForm2.Button1Click(Sender: TObject);
begin

 TThread.CreateAnonymousThread(proc).Start;

end;

procedure TForm2.Proc;
var
refSheet: Integer;
  RowCount,varGridRow:Integer;
  i, j,k: Integer;
  desc, refDesc, refRate: string;
  delta: Integer;
  OldValue:String;
  ws: Variant;
  ExcelApp: Variant;
begin
Tthread.Synchronize(nil,procedure ()begin
if OpenDialog1.Execute then
 begin
 ExcelApp := CreateOleObject('Excel.Application');
 ExcelApp.Workbooks.Open(OpenDialog1.FileName);
 end;
 end);

 Tthread.Synchronize(nil,procedure ()  begin
  refSheet :=StrToInt(InputBox('','','3'));
  if (refSheet <= 0) or (refSheet > ExcelApp.Worksheets.Count) then
  begin
    ShowMessage('Invalid sheet number');
    Exit;
  end;
 end);

 Tthread.Queue(nil,procedure ()var i,j,k:Integer; begin
 IssamProgressBar1.Max:= ExcelApp.Worksheets[refSheet].UsedRange.Rows.Count;
  RowCount:=1;
  varGridRow := 1;
  for i := 2 to ExcelApp.Worksheets[refSheet].UsedRange.Rows.Count do
   begin
    IssamProgressBar1.Progress:=i-2;
    IssamProgressBar1.Refresh;
    if (not VarIsEmpty(ExcelApp.Worksheets[refSheet].Cells[i, 2].Value))and (not VarIsEmpty(ExcelApp.Worksheets[refSheet].Cells[i, 1].Value)) then
    begin
      refDesc := ExcelApp.Worksheets[refSheet].Cells[i, 2].Text;
      refRate := ExcelApp.Worksheets[refSheet].Cells[i, 5].Text;
      Label3.Caption:=refDesc;
      Label3.Refresh;
      // Loop through other sheets

      for j := 1 to ExcelApp.ActiveWorkbook.Sheets.Count do
      begin
       ws := ExcelApp.ActiveWorkbook.Sheets[j];
        if ws.Index <> refSheet then
        begin
          // Loop through rows in current sheet
          Label1.Caption:='Checking Sheet : '+ExcelApp.Worksheets[j].name;
          Label1.Refresh;
          for k := 2 to ws.UsedRange.Rows.Count do
          begin
            // Check if description matches approximately
            desc := ws.Cells[k, 2].Value;


            if (not VarIsEmpty(desc)) and (Not VarIsEmpty(ws.Cells[k, 1].Value)) then
            begin
              Label5.Caption:=desc;
              Label5.Refresh;
              if (refDesc = desc) and (refDesc <> 'Set of spare parts;') and (refDesc <> 'Set of tools and instruments;') then
              begin
                // Update rate
                if (ws.Cells[k, 5].Value <> refRate) and VarIsNumeric(ws.Cells[k, 5].Value) then
                begin

                  ws.Cells[k, 7].Value := ws.Cells[k, 5].Value;
                  OldValue:=ws.Cells[k, 5].Value;
                  ws.Cells[k, 5].Value := refRate;
                  delta := delta + 1;
                  ws.Cells[k, 5].Font.Color := RGB(255, 0, 0);
                  with StringGrid1 do
                  begin
                  RowCount := RowCount + 1;
                  Cells[0, varGridRow] := IntToStr(varGridRow);
                  Cells[1, varGridRow] := refDesc;
                  Cells[2, varGridRow] := OldValue;
                  Cells[3, varGridRow] := refRate;
                  Cells[4, varGridRow] := ExcelApp.Worksheets[j].Name;
                  Cells[5, varGridRow] := IntToStr(j);
                  Inc(varGridRow);
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
 end;
 end);

IssamProgressBar1.Progress:=0;
Label1.Caption:='';
Label3.Caption:='';
Label5.Caption:='';
ExcelApp.ActiveWorkbook.Close(False);
ExcelApp.Quit;


end;

My question is how to make my Proc procedure works in parallel with my app .

Answer 1

You can't use the Excel COM object across thread boundaries. Your whole thread design is wrong. You need to create the COM object in the worker thread, not in the main thread. Then sync with the main thread only to get the filename (or ask for it before starting the thread), and then load and process the file entirely in the worker thread, not in the main thread. Sync with the main thread only when accessing the UI as needed.

In other words, all of your COM object processing should be only in the worker thread, not in the main thread. You are syncing way too much work, defeating the whole point of using a thread.

Try something more like this:

procedure TForm2.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    ProcessFileInThread(OpenDialog1.FileName);
end;

procedure TForm2.ProcessFileInThread(const AFileName: string);
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      InitThreadProc(AFileName);
    end
  ).Start;
end;

procedure TForm2.InitThreadProc(const AFileName: string);
begin
  CoInitialize(nil);
  try
    ProcessFile(AFileName);
  finally
    CoUninitialize;
  end;
end;

procedure TForm2.ProcessFile(const AFileName: string);
var
  refSheet, sheetCount, usedRowCount, RowCount: Integer;
  i, j, k: Integer;
  desc, refDesc, refRate, oldValue: string;
  ExcelApp, refWorksheet, curWorksheet, tmpValue: Variant;
begin
  ExcelApp := CreateOleObject('Excel.Application');
  try
    ExcelApp.Workbooks.Open(AFileName);
    try
      sheetCount := ExcelApp.Worksheets.Count;

      TThread.Synchronize(nil,
        procedure
        begin
          refSheet := StrToIntDef(InputBox('','','3'), -1);
          if (refSheet <= 0) or (refSheet > sheetCount) then
          begin
            ShowMessage('Invalid sheet number');
            Abort;
          end;
        end
      );

      refWorksheet := ExcelApp.Worksheets[refSheet];
      usedRowCount := refWorksheet.UsedRange.Rows.Count;

      ClearGrid;
      UpdateProgress(0, usedRowCount);

      for i := 2 to usedRowCount do
      begin
        UpdateProgress(i-2);

        if VarIsEmpty(refWorksheet.Cells[i, 2].Value) or VarIsEmpty(refWorksheet.Cells[i, 1].Value) then
          Continue;

        refDesc := refWorksheet.Cells[i, 2].Text;
        refRate := refWorksheet.Cells[i, 5].Text;

        UpdateLabel(Label3, refDesc);

        // Loop through other sheets
        for j := 1 to ExcelApp.ActiveWorkbook.Sheets.Count do
        begin
          curWorksheet := ExcelApp.ActiveWorkbook.Sheets[j];
          if curWorksheet.Index = refSheet then
            Continue;

          UpdateLabel(Label1, 'Checking Sheet : ' + curWorksheet.name);

          // Loop through rows in current sheet
          for k := 2 to curWorksheet.UsedRange.Rows.Count do
          begin
            // Check if description matches approximately
            tmpValue := curWorksheet.Cells[k, 2].Value;
            if VarIsEmpty(tmpValue) or VarIsEmpty(curWorksheet.Cells[k, 1].Value) then
              Continue;

            desc := VarToStr(tmpValue);
            UpdateLabel(Label5, desc);

            if (refDesc <> desc) or
               (refDesc = 'Set of spare parts;') or
               (refDesc = 'Set of tools and instruments;') or
               (curWorksheet.Cells[k, 5].Value = refRate) or
               (not VarIsNumeric(curWorksheet.Cells[k, 5].Value)) then
              Continue;

            // Update rate
            curWorksheet.Cells[k, 7].Value := curWorksheet.Cells[k, 5].Value;
            oldValue := curWorksheet.Cells[k, 5].Value;
            curWorksheet.Cells[k, 5].Value := refRate;
            curWorksheet.Cells[k, 5].Font.Color := RGB(255, 0, 0);
            AddToGrid(refDesc, oldValue, refRate, curWorksheet.Name, j);
          end;
        end;
      end;

      ClearStatus;
    finally
       ExcelApp.ActiveWorkbook.Close(False);
    end;
  finally
    ExcelApp.Quit;
  end;
end;

procedure TForm2.UpdateProgress(AValue: Integer; AMax: Integer = -1);
begin
  TThread.Queue(nil,
    procedure
    begin
      if AMax > -1 then IssamProgressBar1.Max := AValue;
      IssamProgressBar1.Progress := AValue;
    end
  );
end;

procedure TForm2.UpdateLabel(ALabel: TLabel; const AText: string);
begin
  TThread.Queue(nil,
    procedure
    begin
      ALabel.Caption := AText;
    end
  );
end;

procedure TForm1.AddToGrid(
  const ADesc, AOldValue, ARate, ASheetName: string;
  ASheetIndex: Integer);
var
  Row: Integer;
begin
  TThread.Queue(nil,
    procedure
    begin
      Row := StringGrid1.RowCount;
      StringGrid1.RowCount := Row + 1;
      StringGrid1.Cells[0, Row] := IntToStr(Row);
      StringGrid1.Cells[1, Row] := ADesc;
      StringGrid1.Cells[2, Row] := AOldValue;
      StringGrid1.Cells[3, Row] := ARate;
      StringGrid1.Cells[4, Row] := ASheetName;
      StringGrid1.Cells[5, Row] := IntToStr(ASheetIndex);
    end
  );
end;

procedure TForm2.ClearGrid;
begin
  TThread.Queue(nil,
    procedure
    var
      i: Integer;
    begin
      StringGrid1.RowCount := 1;
      for i := 0 to StringGrid1.ColCount-1 do
        StringGrid1.Cells[i, 0] = '';
    end;
  );
end;

procedure TForm2.ClearStatus;
begin
  TThread.Queue(nil,
    procedure
    begin
      IssamProgressBar1.Progress := 0;
      Label1.Caption := '';
      Label3.Caption := '';
      Label5.Caption := '';
    end
  );
end;