谢谢！

感谢提示
在测试的时候是没有EXCEL表格被打开，有时甚至是重新启动计算机后做的测试
另外，出现问题都是在粘贴的时候，感觉这个粘贴功能很脆弱，一会行一会不行的

感谢版主回复
数组的方法还真没用过，我试试

回吹版
数组的方法试了下，还是存在下面的问题：
1.纯数字内容的字符型字段（如身份证号），导出后成了数字型
2.时间内容导出后只保留到了  yyyy-mm-dd hh:mm，后面的秒被截断了

19楼提到以前的贴也有提到数据格式问题
试试加个格式设置

CREATE CURSOR 测试表 (编号 C(10), 入库单号 C(7), 入库日期 D, 物料名称 C(20), 数量 I,;
    单价 N(14,2), 单位 C(8), 规格 C(30), 付款 L, 日期时间 T, 备注 M)
FOR i=1 To 10
    INSERT INTO 测试表 VALUES (PADL(i,10,"0"), 'C'+PADL(i,6,'0'), {^2018-03-01}+INT(RAND()*10),;
         '物料'+PADL(i,3,'0'), INT(RAND()*1000), RAND()*10, '个', '"测试双引号AB"CD"',;
         IIF(i%2=0,.t.,.f.), DATETIME(), '"备注_"'+TRANSFORM(i)+'"'+0h0D0A+'_'+TRANSFORM(i)+'"'+0h0D0A)
ENDFOR
AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,1)
    aFieldInfo[i,8] = ICASE(;    && 数据格式
        aFieldInfo[i,2]=="I", '##0;[=0]""',;              && 整数格式
        INLIST(aFieldInfo[i,2],"B","N","F"), '#,##0.'+REPLICATE("0",aFieldInfo[i,4])+';[=0]""',; && 小数格式
        INLIST(aFieldInfo[i,2],"C","V","W","M"), '@',;    && 文本格式
        aFieldInfo[i,2]=="D", 'yyyy-m-d',;                && 日期格式
        aFieldInfo[i,2]=="T", 'yyyy-m-d hh:mm:ss',;       && 日期时间格式
        'G/通用格式') 
ENDFOR
SELECT * FROM 测试表 INTO ARRAY arr
sc = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO vbsCode TEXTMERGE NOSHOW PRETEXT 7
    FUNCTION fun(vfpArray, aFieldInfo)
        dim oExcel,oRange, nRows, nCols, nCol
        set oExcel = CREATEOBJECT("Excel.Application")
        oExcel.Workbooks.Add
        nRows = UBound(vfpArray,1)
        nCols = UBound(vfpArray,2)
        for nCol=1 to nCols
            oExcel.Range(oExcel.Cells(1,nCol),oExcel.Cells(nRows,nCol)).Select
            oExcel.Selection.NumberFormatLocal = aFieldInfo(nCol,8)
        next
        set oRange = oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols))
        oRange.Value = vfpArray
        oRange.Columns.AutoFit
        oExcel.Visible = 1
    END FUNCTION 
ENDTEXT  
sc.AddCode(vbsCode)
sc.Run("fun", @arr, @aFieldInfo)

回吹版
加上格式设置确实可以导出了，解决了之前的问题
我导出的表字段有39个，导出到3W条时报内存不足错误，执行中断。
估计按安全的条数分别导出后再合并到一个表里应该可以解决大记录数导出的问题

之前大数据量（2W以上）导出EXCEL时都是在使用oExcel.paste时出错，但又无法再现错误，相同的数据内容，大概一半多的时候是可以正常导出，其他就不敢保了
另外，使用剪贴板进行粘贴，当数据量大到一定程度时，效率会出现几何级降低

[此贴子已经被作者于2021-9-17 19:48编辑过]

可能数据量超出数组的限制，可以试试分块追加：

CREATE CURSOR 测试表 (编号 C(10), 入库单号 C(7), 入库日期 D, 物料名称 C(20), 数量 I,;
    单价 N(14,2), 单位 C(8), 规格 C(30), 付款 L, 日期时间 T, 备注 M)
FOR i=1 To 100
    INSERT INTO 测试表 VALUES (PADL(i,10,"0"), 'C'+PADL(i,6,'0'), {^2018-03-01}+INT(RAND()*10),;
         '物料'+PADL(i,3,'0'), INT(RAND()*1000), RAND()*10, '个', '"测试双引号AB"CD"',;
         IIF(i%2=0,.t.,.f.), DATETIME(), '"备注_"'+TRANSFORM(i)+'"'+0h0D0A+'_'+TRANSFORM(i)+'"'+0h0D0A)
ENDFOR

AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,1)
    aFieldInfo[i,8] = ICASE(;    && 数据格式
        aFieldInfo[i,2]=="I", '##0;[=0]""',;              && 整数格式
        INLIST(aFieldInfo[i,2],"B","N","F"), '#,##0.'+REPLICATE("0",aFieldInfo[i,4])+';[=0]""',; && 小数格式
        INLIST(aFieldInfo[i,2],"C","V","W","M"), '@',;    && 文本格式
        aFieldInfo[i,2]=="D", 'yyyy-m-d',;                && 日期格式
        aFieldInfo[i,2]=="T", 'yyyy-m-d hh:mm:ss',;       && 日期时间格式
        'G/通用格式') 
ENDFOR
sc = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO vbsCode TEXTMERGE NOSHOW PRETEXT 7
    dim oExcel,oRange, nRows, nCols, nCol
    set oExcel = CREATEOBJECT("Excel.Application")
    oExcel.Workbooks.Add

    function SetFormat(aFieldInfo, nRows)
        for nCol=1 to UBound(aFieldInfo,1)
            oExcel.Range(oExcel.Cells(1,nCol),oExcel.Cells(nRows,nCol)).Select
            oExcel.Selection.NumberFormatLocal = aFieldInfo(nCol,8)
        next  
    end function 

    function Append(vfpArray, nRow)
        nRows = UBound(vfpArray,1)
        nCols = UBound(vfpArray,2)
        oExcel.Range(oExcel.Cells(nRow,1),oExcel.Cells(nRow+nRows-1,nCols)).Value = vfpArray
    end function 
    
    function Show(nRows, nCols)
        oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
        oExcel.Visible = 1   
    end function 
ENDTEXT  
sc.AddCode(vbsCode)
sc.Run("SetFormat", @aFieldInfo, RECCOUNT("测试表"))
nStep = 10
FOR i=1 TO RECCOUNT("测试表") STEP nStep
    SELECT * FROM 测试表 WHERE BETWEEN(RECNO(),i,i+nStep-1) INTO ARRAY arr
    sc.Run("Append", @arr, i)
ENDFOR
sc.Run("Show",RECCOUNT("测试表"),FCOUNT("测试表"))

谢吹版！！！！！！
上面的程序可完美解决问题
经测试，每批次20000条时用时较少，10W条记录（39个字段），导出用时13秒
相同数据量，每批次10000条时，用时20秒

吹版好，根据您上面提供的程序，做了个导出EXCEL函数，请指正
（1）可在一个EXCEL中导出不同sheet
（2）加上了表头行
（3）测试结果：sheet1-7042条，sheet2-473765条，用时277秒

FUNCTION Dbf2excel(cExcelfilename,cDbfname,cSheetname,cFields,cFilter)
********************************************************
* cExcelfilename：C,带完整路径的EXCEL文件全名，abc.xlsx
* cDbfname: C,数据文件名
* cSheetname: C，工作表名字，可空
* cFields: C,"class 班级,name 姓名,math 数学"
* cFilter: C，数据过滤条件，可空
********************************************************
cFields = EVL(cFields,'*')
cSheetname = EVL(cSheetname,'')
cFilter = EVL(cFilter,'1=1')

LOCAL sc,arr[1],vbsCode,aFieldInfo[1],nStep,xnewfile,xtmpfile,i,xfile
xfile = cDbfname

sc = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO vbsCode TEXTMERGE NOSHOW PRETEXT 7
    dim oExcel,oRange, nRows, nCols, nCol,cExcelname
    set oExcel = CREATEOBJECT("Excel.Application")

    function Open(cExcelname,cSheetname,nNew)
        if nNew=0 then        ' 新建
            oExcel.Workbooks.Add
            oExcel.ActiveWorkbook.saveas cExcelname
        else                '已有
            oExcel.Workbooks.Open(cExcelname)
            oExcel.ActiveWorkbook.Worksheets.Add
        end if

        if cSheetname<>"" then
            oExcel.Activesheet.name = cSheetname
        end if
    end function
   
    function SetFormat(aFieldInfo, nRows)
        for nCol=1 to UBound(aFieldInfo,1)
            oExcel.Range(oExcel.Cells(1,nCol),oExcel.Cells(nRows,nCol)).Select
            oExcel.Selection.NumberFormatLocal = aFieldInfo(nCol,8)
        next  
    end function

    function Append(vfpArray, nRow)
        nRows = UBound(vfpArray,1)
        nCols = UBound(vfpArray,2)
        oExcel.Range(oExcel.Cells(nRow,1),oExcel.Cells(nRow+nRows-1,nCols)).Value = vfpArray
    end function

    function Close(nRows, nCols)
        oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
        oExcel.Cells(1,1).select
        oExcel.ActiveWorkbook.save
        oExcel.quit
    end function
   
    function Show(nRows, nCols)
        oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
        oExcel.Visible = 1   
    end function
ENDTEXT  
sc.AddCode(vbsCode)

* 是否新建EXCEL文件
xnewfile = IIF(file(cExcelfilename),1,0)
sc.Run("Open", cExcelfilename,cSheetname,xnewfile)

* 表头数组
xtmpfile = SYS(2015)
SELECT &cFields FROM &xfile WHERE &cFilter INTO CURSOR &xtmpfile READWRITE
DIMENSION arr[1,fcount(xtmpfile)]

* 字段类型
SELECT &xtmpfile
AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,1)
    arr[1,i] = aFieldInfo[i,1]
    aFieldInfo[i,8] = ICASE(;    && 数据格式
        aFieldInfo[i,2]=="I", '##0;[=0]""',;              && 整数格式
        INLIST(aFieldInfo[i,2],"B","N","F"), '#,##0.'+REPLICATE("0",aFieldInfo[i,4])+';[=0]""',; && 小数格式
        INLIST(aFieldInfo[i,2],"C","V","W","M"), '@',;    && 文本格式
        aFieldInfo[i,2]=="D", 'yyyy-m-d',;                && 日期格式
        aFieldInfo[i,2]=="T", 'yyyy-m-d hh:mm:ss',;       && 日期时间格式
        'G/通用格式')
ENDFOR

* 插入表头
sc.Run("Append", @arr, 1)

* 各列格式
sc.Run("SetFormat", @aFieldInfo, RECCOUNT(xtmpfile)+1)

* 表体
nStep = 10000
FOR i=1 TO RECCOUNT(xtmpfile) STEP nStep
    SELECT * FROM &xtmpfile WHERE BETWEEN(RECNO(),i,i+nStep-1) INTO ARRAY arr
    sc.Run("Append", @arr, i+1)
ENDFOR

sc.Run("Close",RECCOUNT(xtmpfile),FCOUNT(xtmpfile))

*sc.Run("Show",RECCOUNT(xfile),FCOUNT(xfile))
* 如果需要当时查看EXCEL表，可执行上面的语句

RELEASE sc
RETURN