*//   Test.prg
*//   Convert dbf file to Excel file.
*//   This code is a basic sample.
*//   Using Visual dBase 5.7 or dBasePlus 2.01 or dBasePlus 9.51.
*//   The cells formats arent for the french country, change if not french.
*//   Look if the function ansi() is wanted.
*//   Look if the decimal deparator is coma or point.
*//   This code execute can be long time for big table.

*// Output file Excel.
#define Excel_File12 set( "directory" ) + "\_Result.xlsx"
#define Excel_File11 set( "directory" ) + "\_Result.xls"

*// https://www.automateexcel.com/excel-formatting/color-reference-for-color-index/#VBA_Color_Index_Codes_List
#define COLOR_YELLOW  6
#define COLOR_GRAY15 15

clear all
clear

local aFields
local cFormat
local nCol
local nRow
local oBook
local oCol
local oCell
local oExcel
local oSheet

private cPath
private cTable
private fName

*// For load the batch file : << c:\VISUALDB\BIN\DBASEWIN.exe %~dp0Test.prg >>
cPath = substr( program( 0 ), 1, rat( "\", program( 0 ) ) - 1 )
set directory to &cPath

#ifdef __version__
   if __version__ < 3 
      cTable = getfile( "*.dbf*", "Select Dbf file" )
   else
      cTable = getfile( "", "Select Dbf file", .T., "Dbf files ( *.dbf* )" )
   endif
#else
   cTable = getfile( "*.dbf*", "Select Dbf file" )
#endif

if len( cTable ) == 0
   release cPath
   msgbox( "Dbf file not selected, abort.", "Error", 48 )
   return
endif

use &cTable
aFields = new array( fldcount(), 4 )
aFields.fields()

oExcel               = new OleAutoClient( "Excel.Application" )
oExcel.Visible       = .T.
oExcel.DisplayAlerts = .F.
oBook                = oExcel.Workbooks.Add()
oSheet               = oBook.Worksheets( 1 )
oSheet.Name          = "DbfToExcel"

oSheet.Cells.Borders.LineStyle  = .T.
oExcel.ActiveWindow.SplitRow    = 1
oExcel.ActiveWindow.SplitColumn = 0
oExcel.ActiveWindow.FreezePanes = .T.
oExcel.ScreenUpdating           = .F.

nRow = 1

*// Write titles ( fields names ) and columns width for memos fields.
for nCol = 1 to alen( aFields, 1 )
   oCell                     = oSheet.Cells( nRow, nCol )
   oCell.Value               = aFields[ nCol, 1 ]
   oCell.NumberFormat        = "@"
   oCell.Font.Bold           = .T.
   oCell.Font.Italic         = .T.
   oCell.Interior.ColorIndex = COLOR_YELLOW
   if aFields[ nCol, 2 ] = "M"      &&// Memo.
      oCol             = oSheet.Columns( nCol )
      oCol.ColumnWidth = 50
   endif
next

*// Write datas.
do while .not. eof()
   nRow = nRow + 1
   for nCol = 1 to alen( aFields, 1 )
      oCell  = oSheet.Cells( nRow, nCol )
      fName = aFields[ nCol, 1 ]
      do case

      case aFields[ nCol, 2 ] = "C"      &&// Characters.
*//         oCell.Value        = ansi( &fName )
         oCell.Value        = &fName
         oCell.NumberFormat = "@"

      case aFields[ nCol, 2 ] = "D"      &&// Date.
         oCell.Value        = dtoc( &fName )
         oCell.NumberFormat = "jj/mm/aaaa"  &&// French.

      case aFields[ nCol, 2 ] = "L"      &&// Bool.
         if &fName
            oCell.Value = "vrai"
         else
            oCell.Value = "faux"
         endif

      case aFields[ nCol, 2 ] = "M"      &&// Memo.
*//         oCell.Value        = ansi( &fName )
         oCell.Value        = &fName
         oCell.NumberFormat = "@"
         oCell.WrapText     = .T.

      case aFields[ nCol, 2 ] = "N"      &&// Numeric.
         if aFields[ nCol, 4 ] = 0
            cFormat = "0"
         else
*//            cFormat = "0." + replicate( "0", aFields[ nCol, 4 ] )  &&// French if not good with coma.
            cFormat = "0," + replicate( "0", aFields[ nCol, 4 ] )  &&// French.
         endif
         oCell.Value        = &fName
         oCell.NumberFormat = cFormat

      otherwise
         oCell.Value = "*** Error field type << " + aFields[ nCol, 2 ] + " >> not found."

      endcase
      if mod( nRow, 2 ) <> 0
         oCell.Interior.ColorIndex = COLOR_GRAY15
      endif
   next
   skip
enddo
use

oSheet.UsedRange.Columns.AutoFit()
oExcel.ScreenUpdating = .T.

if val( oExcel.Version ) < 12
   oBook.SaveAs( Excel_File11 )
else
   oBook.SaveAs( Excel_File12 )
endif

*//oBook.Close( .T. )
*//oExcel.Quit()

oExcel = null

release cPath
release cTable
release fName

return