针对样本文件文件名命名规则、表格结构(代码不一定最优,但基本实现了所需功能):
cPath=GETDIR()
CLOSE DATABASES
Create Cursor Mydbf (FileName C(100))
IF Adir(cXLS,cPath+"*月份*.XLS?")>0
Append From Array cXLS
ENDIF
IF
Adir(cDOC,cPath+"*月份*.DOC?")>0
Append From Array cDOC
ENDIF
IF RECCOUNT()>0
SELECT 0
CREATE TABLE (cPath+"huizong") (月份 C(2),店名 C(40))
SELECT MyDbf
SCAN
cWaitmesg="正在提取数据 ,请稍候......文件:"+STR(RECNO())+"/"+STR(RECCOUNT())
Wait Window cWaitmesg
Nowait At srow()/2,(scol()-len(cWaitmesg))/2
DO CASE
CASE
"XLS"$UPPER(JUSTEXT(FileName))
oExl=CreateObject('Excel.Application')
oExl.workbooks.open(cPath+FileName)
nRows=oExl.sheets[1].UsedRange.rows.count&&获取指定文件的行数
nCols=oExl.sheets[1].UsedRange.columns.count&&获取指定文件的列
FOR i= 3 TO nRows
INSERT INTO huizong(月份,店名) Value(LEFT(MyDbf.FileName,AT_C("月",MyDbf.FileName)-1),oExl.cells(i,1).Value)
FOR j=2 TO nCols
cFielName=oExl.cells(2,j).Value
SELECT huizong
IF Fsize(cFielName)=0
ALTER TABLE huizong ADD (cFielName) N(8)
ENDIF
REPLACE (cFielName) WITH oExl.cells(i,j).Value
ENDFOR
ENDFOR
oExl.Quit
RELEASE oExl
CASE
"DOC"$UPPER(JUSTEXT(FileName))
oWord = CREATEOBJECT("Word.Application")
oDoc = oword.Documents.Open(cPath+FileName)
FOR EACH tab IN oDoc.Tables
nRows=Tab.Rows.Count&&获取指定文件的行数
nCols=Tab.Columns.Count&&获取指定文件的列
FOR i=2 TO Tab.Rows.Count
INSERT INTO huizong(月份,店名) Value(LEFT(MyDbf.FileName,AT_C("月",MyDbf.FileName)-1),STRTRAN(STRTRAN(Tab.Cell(i,1).Range.Text,CHR(13),''),Chr(7)))
FOR j=2 TO nCols
cfielname=STRTRAN(STRTRAN(Tab.Cell(1,j).Range.Text,CHR(13),''),Chr(7))
SELECT huizong
IF Fsize(cFielName)=0
ALTER TABLE huizong ADD (cFielName) N(8)
ENDIF
REPLACE (cFielName) WITH VAL(Tab.Cell(i,j).Range.Text)
ENDFOR
ENDFOR
ENDFOR
oDoc.Close
oWord.Quit
RELEASE oWord
ENDCASE
ENDSCAN
WAIT CLEAR
ELSE
MESSAGEBOX("选定目录下无符合条件的文件!",0+48+0,"提示:")
ENDIF
USE IN MyDbf
SELECT huizong
brow