Here that turned out. Correctly loads in dbf-table xls and xlsx-files blocks till 65535 lines. I checked on the xlsx-file with 881904 lines
Code: Select all
/*
This test program will export Excel-Sheet to Work Area DBF
*/
#INCLUDE "inkey.ch"
#INCLUDE "dcdir.ch"
#INCLUDE "appevent.ch"
#INCLUDE "xbp.ch"
#INCLUDE "dcprint.ch"
#INCLUDE "dcmsg.ch"
#INCLUDE "dll.ch"
#include "dccursor.ch"
#Include "thread.ch"
#INCLUDE "class.CH"
#INCLUDE "dmlb.CH"
#INCLUDE "fileio.CH"
#INCLUDE "dctree.CH"
#INCLUDE "dcicon.CH"
#INCLUDE "dcdialog.CH"
#INCLUDE "outlook.CH"
#pragma Library("ascom10.lib")
#pragma library( "dclip1.lib" )
#pragma library( "dclip2.lib" )
#pragma library( "dclipx.lib" )
#pragma library( "xbtbase1.lib" )
#pragma library( "xbtbase2.lib" )
#pragma library( "xppui2.lib" )
* ---------------
PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN
* -------------
FUNCTION Main()
PARAMETERS cExcelFile
DC_IconDefault(1000)
IF EMPTY(cExcelFile)
MsgBox('Set as parameter a name of the convertible Excel-file with expansion: "XLS-DBF FileName.xlsx"')
RETURN NIL
ENDIF
CLOSE ALL
PUBLIC mExcelName := cExcelFile
PUBLIC mDbaseName := SUBSTR(cExcelFile, 1, AT('.', cExcelFile)-1)
PUBLIC cDbaseFile := SUBSTR(cExcelFile, 1, AT('.', cExcelFile)-1)+".dbf"
cExcelFile = DC_CurPath() + '\' + cExcelFile
LC_Excel2WorkArea( cExcelFile )
RETURN nil
******************************************
FUNCTION LC_Excel2WorkArea( cExcelFile )
LOCAL lStatus := .f., oExcel, cPath, oSheet, oBook, aValues, i, j, ;
aStru, xValue
LOCAL oProgressm, oDialogm, lOk
#if XPPVER > 1900000
// Create the "Excel.Application" object
oExcel := CreateObject("Excel.Application") // Как определить, какой Excel проинсталлирован на компьютере: 2003 или 2007-2010
IF Empty( oExcel )
DC_WinAlert( "Excel is not installed" )
RETURN .f.
ENDIF
#else
DC_WinAlert('This feature is available in Xbase++ 1.9 and later only!')
RETURN .f.
#endif
oExcel:Visible := .f.
// Load a Workbook from an .XLS file
// Get path from ini file
IF !File(cExcelFile)
mMess = "The file # isn't found";mMess = STRTRAN(mMess, '#', mExcelName )
DC_WinAlert( mMess )
RETURN lStatus
ENDIF
// Активизация чтения Excel-листа
mMess := 'File opening: "#"';mMess = STRTRAN(mMess, "#", mExcelName)
oScrn := DC_WaitOn( mMess )
oBook := oExcel:Workbooks:Open(cExcelFile)
oSheet := oBook:activeSheet
*aValues := oBook:workSheets(1):usedRange:value // Загрузка 1-го листа Excel-книги целиком
// Определение количества строк и столбцов с данными в Excel-дисте без его загрузки в оперативную память
oUsedRange := oSheet:usedRange
N_Col := oUsedRange:Columns:Count() // Количество колонок с данными в xls-файле
N_Rec := oUsedRange:Rows:Count() // Количество строк с данными в xls-файле
DC_Impl(oScrn)
********* Сформировать файл Inp_name.txt // Наименования классификационных и описательных шкал
// R1C1_A1() возвращает буквенные имена колонок по их номеру
// чтобы сформировать текстовую переменную для обращения к Range()
mLinkBlock = "A1:"+R1C1_A1(N_Col)+'1' // Традиционное буквенное обозначение столбцов xls-листа
aValues := oUsedRange:Range(mLinkBlock):Value // Загрузка ДВУМЕРНОГО массива из одной строки с именами колонок 1-го листа Excel-книги
aInp_name = aValues[1] // Присвоение массиву имен колонок aInp_name знаачений первой строки массива aValues
// Проверка на то, что в 1-й строке ТЕКСТОВЫЙ тип данных (заголовки колонок), и, если нет, выдать сообщение об этом и выйти
FOR j=1 TO N_Col
IF VALTYPE(aInp_name[j]) <> 'C'
DC_WinAlert( 'In the 1-st line of the Excel-file there has to be a text heading' )
* DC_WinAlert( 'В 1-й строке Excel-файла должен быть текстовый заголовок' )
oBook:close()
oBook:destroy()
// Quit Excel
oExcel:Quit()
oExcel:Destroy()
RETURN lStatus
ENDIF
NEXT
CrLf = CHR(13)+CHR(10) // Конец строки (абзаца) (CrLf)
mCol_name = ""
FOR j=2 TO N_Col // 1-ю колонку не включаем в Inp_name.txt, т.к. это инф.об источнике данных, а не шкала
mNameJ = ALLTRIM(aInp_name[j])
mNameJ = UPPER(SUBSTR(mNameJ,1,1)) + SUBSTR(mNameJ,2) // Сделать первые символы заголовков колонок большими, а остальные оставить как есть
mCol_name = mCol_name + mNameJ + CrLf
NEXT
StrFile(mCol_name, 'Inp_name.txt') // Добавить путь на папку Inp_data
// Создание пустой dbf-таблицы для записи в нее данных из 1-го листа xls-файла ******************
// Определение структуры для dbf-таблицы по значениям всех строк (тип и формат данных в колонках)
// На основе просмотра ВСЕГО xls-файла сделать массивы описания полей и для создания структуры брать MAX из каждого массива
// В dbf-таблицу переносить данные, начиная со 2-й строки xls-листа
// 1-ю строку с наименованиями полей использовать вместо Inp_name.txt или чтобы автоматически его делать
aStructure := {} // Массив структуры dbf-таблицы
PRIVATE aFieldName[N_col] // Наименования колонок для базы данных Inp_data.dbf
PRIVATE aFieldType[N_Col] // Тип значений в j-й колонке (если есть хотя бы одно текстовое, то текстовое)
PRIVATE aFieldSize[N_Col] // Максимальный размер значения в j-й колонке в символах
PRIVATE aFieldInt [N_Col] // Максимальное количество значащих цифр до десятичной точки в значениях j-й колонки
PRIVATE aFieldDeci[N_Col] // Максимальное количество значащих цифр после десятичной точки в значениях j-й колонки
PRIVATE aFlag_neg [N_Col] // Флаг наличия отрицательных значений в j-й колонке
AFILL(aFieldType, "X" )
AFILL(aFieldSize, 1 )
AFILL(aFieldInt , 1 )
AFILL(aFieldDeci, 0 )
AFILL(aFlag_neg , .F. )
FOR j=1 TO N_Col
aFieldName[j] = "N"+ALLTRIM(STR(j, 15))
NEXT
// Сдесь сделать цикл по загружаемым блокам xls-листа по N_BlockRec записей
* N_Rec // Кол-во записей в исходном xls-файле
* N_Col // Кол-во колонок в исходном xls-файле
N_RecBlock = 65535 // Кол-во записей в блоке загрузки
N_Block = 1 + INT( N_Rec / N_RecBlock ) // Кол-во полных блоков загрузки
N_RecBlockEnd = ABS( N_Rec - N_RecBlock * ( N_Block - 1 ) ) // Кол-во записей в споследнем (неполном) блоке загрузки, если он есть (число записей в нем > 0)
***** Отображение стадии исполнения в кратком варианте *****************************************
nMax = N_Col * N_Rec + N_Rec - 1
nTime = 0
@ 4,5 DCPROGRESS oProgressm SIZE 70,1.1 MAXCOUNT nMax COLOR GRA_CLR_CYAN PERCENT EVERY 100
mMess = 'Converting Excel-file to DBF (by prof.E.V.Lutsenko)'
*mMess = STRTRAN(mMess, "#", mExcelName)
*mMess = STRTRAN(mMess, "$", cDbaseFile)
DCREAD GUI TITLE mMess PARENT @oDialogm FIT EXIT
oDialogm:show()
DC_GetProgress(oProgressm,0,nMax)
************************************************************************************************
FOR j=1 TO N_Col // Цикл по колонкам блока загрузки
FOR mNumBlock = 1 TO N_Block
IF mNumBlock = 1
mRec1 = 2 + (mNumBlock - 1) * N_RecBlock // Начальная запись блока загрузки (в 1-м блоке наим.колонок здесь не загружать)
ELSE
mRec1 = 1 + (mNumBlock - 1) * N_RecBlock // Начальная запись блока загрузки
ENDIF
IF mNumBlock * N_RecBlock <= N_Rec
mRec2 = mNumBlock * N_RecBlock // Конечная запись блока загрузки
ELSE
mRec2 = N_Rec // Конечная запись блока загрузки = конечной записи xls-листа
ENDIF
mLinkBlock = R1C1_A1(j)+ALLTRIM(STR(mRec1,15))+":"+R1C1_A1(j)+ALLTRIM(STR(mRec2,15)) // Код обращения к j-му столбцу блока загрузки для Range()
aValues := oUsedRange:Range(mLinkBlock):Value // Загрузка ДВУМЕРНОГО массива из одной строки с именами колонок 1-го листа Excel-книги
FOR i=1 TO mRec2 - mRec1 + 1 // Цикл по строкам блока загрузки (посчитать сколько в нем строк)
mFieldType = VALTYPE(aValues[i,1])
DO CASE
CASE mFieldType = "C" // **************************************************************************
aFieldType[j] = "C" // Тип значений в j-й колонке (если есть хотя бы одно текстовое, то текстовое)
aFieldSize[j] = MAX(aFieldSize[j], LEN(ALLTRIM(aValues[i,1])))
aFieldDeci[j] = 0
CASE mFieldType = "N" // **************************************************************************
IF aValues[i,1] < 0
aFlag_neg[j] = .T.
ENDIF
IF aFieldType[j] <> 'C'
aFieldType[j] = 'N'
ENDIF
mVal = ALLTRIM(STR(aValues[i,1],22,7))
mVal = REMRIGHT(mVal,"0") // Убрать подряд идущие нули справа до 1-й значащей цифры
Pos = AT('.', MVal)
DO CASE
CASE Pos = 0 // Целое число
aFieldInt [j] = MAX(aFieldInt [j], LEN(ALLTRIM(mVal))) // Определить число значащих цифр ДО запятой без ведущих нулей
aFieldDeci[j] = 0
// Если отрицательное, то символ на знак
aFieldSize[j] = MAX(aFieldSize[j], aFieldInt[j] + IF(aFlag_neg[j],1,0))
CASE Pos > 0 // Число с дробной частью
aFieldInt [j] = Pos - 1 // Определить число значащих цифр ДО запятой без ведущих нулей
mFieldDeci = LEN(ALLTRIM(mVal)) - aFieldInt [j] - 1
aFieldDeci[j] = MAX(aFieldDeci[j], mFieldDeci)
// Если с дробной частью, то плюс символ на точку
// Если отрицательное, то символ на знак
aFieldSize[j] = MAX(aFieldSize[j], aFieldInt[j] + aFieldDeci[j] + 1 + IF(aFlag_neg[j],1,0))
ENDCASE
CASE mFieldType = "D" // **************************************************************************
aFieldType[j] = "C"
aFieldSize[j] = 10
aFieldDeci[j] = 0
ENDCASE
DC_GetProgress(oProgressm, ++nTime, nMax)
NEXT
NEXT
AADD(aStructure, { aFieldName[j] , aFieldType[j], aFieldSize[j], aFieldDeci[j] }) // Добавить строку в структуру dbf-таблицы
NEXT
*DC_DebugQout( { aStructure } )
*MsgBox('Stop')
DbCreate( mDbaseName , aStructure )
***** Цикл переноса данных из xls-листа в dbf-таблицу
CLOSE ALL
USE (mDbaseName) EXCLUSIVE NEW;ZAP
SELECT (mDbaseName)
FOR mNumBlock = 1 TO N_Block
IF mNumBlock = 1
mRec1 = 2 + (mNumBlock - 1) * N_RecBlock // Начальная запись блока загрузки (в 1-м блоке наим.колонок здесь не загружать)
ELSE
mRec1 = 1 + (mNumBlock - 1) * N_RecBlock // Начальная запись блока загрузки
ENDIF
IF mNumBlock * N_RecBlock <= N_Rec
mRec2 = mNumBlock * N_RecBlock // Конечная запись блока загрузки
ELSE
mRec2 = N_Rec // Конечная запись блока загрузки = конечной записи xls-листа
ENDIF
mLinkBlock = "A"+ALLTRIM(STR(mRec1,15))+":"+R1C1_A1(N_Col)+ALLTRIM(STR(mRec2,15)) // Код обращения к блоку загрузки для Range()
aValues := oUsedRange:Range(mLinkBlock):Value // Загрузка ДВУМЕРНОГО массива из одной строки с именами колонок 1-го листа Excel-книги
FOR i=1 TO mRec2 - mRec1 + 1 // Цикл по строкам блока загрузки (посчитать сколько в нем строк)
DBAPPEND()
FOR j=1 TO N_Col // Цикл по колонкам блока загрузки
// Преобразовывать значения с типами числа и даты в текст, если тип поля текст
DO CASE
CASE VALTYPE(aValues[i,j]) = 'C' .AND. aFieldType[j] = 'C'
FIELDPUT(j, aValues[i,j]) // Просто занести
CASE VALTYPE(aValues[i,j]) = 'N' .AND. aFieldType[j] = 'N'
FIELDPUT(j, aValues[i,j]) // Просто занести
CASE VALTYPE(aValues[i,j]) = 'N' .AND. aFieldType[j] = 'C'
FIELDPUT(j, STR(aValues[i,j], aFieldSize[j], aFieldDeci[j] )) // Преобразовать число к текстовому виду
CASE VALTYPE(aValues[i,j]) = 'D' .AND. aFieldType[j] = 'C'
FIELDPUT(j, DTOC(aValues[i,j])) // Преобразовать дату к текстовому виду
ENDCASE
NEXT
DC_GetProgress(oProgressm, ++nTime, nMax)
NEXT
NEXT
DC_GetProgress(oProgressm,nMax,nMax)
oDialogm:Destroy()
oBook:close()
oBook:destroy()
// Quit Excel
oExcel:Quit()
oExcel:Destroy()
RETURN lStatus
* ###################### Окончание программы конвертации XLS -> DBF #################
******** Функция преобразования номера колонки в ее буквенное наименование
FUNCTION R1C1_A1(mNumColumn)
aLiterCol := {}
******** Однобуквенные наименования столбцов
FOR j1=1 TO 26
AADD(aLiterCol, CHR(j1+64))
NEXT
*DC_DebugQout( { aLiterCol } )
******** Двухбуквенные наименования столбцов
FOR j1=1 TO 26
FOR j2=1 TO 26
AADD(aLiterCol, CHR(j1+64)+CHR(j2+64))
NEXT
NEXT
******** Трехбуквенные наименования столбцов
FOR j1=1 TO 26
FOR j2=1 TO 26
FOR j3=1 TO 26
AADD(aLiterCol, CHR(j1+64)+CHR(j2+64)+CHR(j3+64))
NEXT
NEXT
NEXT
RETURN(aLiterCol[mNumColumn])
**************************************
* cEnde := ZAHL2CHR(numColumns)
* aExcel := oSheet:range( "A1:"+cEnde+LTRIM(STR(numRows)) ):value
FUNCTION ZAHL2CHR(numColumns)
LOCAL nMal
LOCAL cEnde
IF numColumns > 26
nMal := INT(numColumns/26)
cEnde := CHR(nMal+64)+CHR((numColumns-(nMal*26))+64)
ELSE
cEnde := CHR(numColumns+64)
ENDIF
RETURN cEnde
Calculation of lines, columns and arguments for Range () is made as in the file:
Test database (initial-xlsx and result of transformation-dbf), the source text of the program, its executable module and the Excel-program of calculation of lines and columns of blocks of loading are given in archive:
As in the dbf-file can not be headings of columns of non-text types of data, for these headings I made the separate file: Inp_name.txt DOS-text type.
Still it is necessary to tell that I did this program not absolutely universal, but such as it is necessary to me for system of Aidos-X++
By the way, how to reduce quantity of dll necessary for work of the program to a minimum? I have such impression that probably some of them aren't necessary.
