vfp直接读取EXCEL文件的示例(转)。

M_File=GETFILE('xls','订单文件')
IF M_File=""
   =MESSAGEBOX("请选择待导入的收订单文件！",0+48,"提示")
   RETURN
ELSE
   IF JUSTEXT(M_FILE)#"XLS"  &&获得文件扩展名
      =MESSAGEBOX("您选择的不是EXCEL文档！",0+48,"提示")
      RETURN
   ENDIF
ENDIF
USE 图书订单表
ZAP
myexcel=createobject('excel.application')      &&创建一个对象
myexcel.visible=.f.&&不可见
bookexcel=myexcel.workbooks.open(M_File)      &&打开指定文件
o_SheetName=myexcel.application.ActiveSheet.Name    &&获取当前激活工作表的名称
UsedRange =bookexcel.worksheets(o_SheetName).UsedRange     &&返回工作表中可使用的区域，UsedRange表的属性
o_rows=UsedRange.rows.count    &&汇总行
o_cols=UsedRange.columns.count    &&汇总列
IF o_rows<=1
   =MESSAGEBOX("待导入数据行数太少，请检查！",0+16,"提示")
ELSE
   FOR i=2 TO o_rows
       m1=myexcel.cells(i,1).value      &&书号     
       m2=myexcel.cells(i,2).value      &&书名      
       m3=myexcel.cells(i,3).value      &&出版社
       m4=myexcel.cells(i,4).value      &&作者      
       m5=myexcel.cells(i,5).value      &&定价
       m6=myexcel.cells(i,6).value      &&数量
       APPEND BLANK
       REPLACE 书号 WITH m1,书名 WITH m2,出版社 WITH m3,作者 WITH m4,定价 WITH m5,数量 WITH m6
    ENDFOR
ENDIF
myexcel.workbooks.close    &&关闭工作区
myexcel.quit    &&关闭excel
brow

這段程序有點小BUG，注意到沒有？你看看Office 2007的Excel文件擴展名是什麽，各種Office文檔都有些什麽擴展名。

還有，前面GETFILE()的時候已經限制爲XLS文件，後面就無需再判斷擴展名不是XLS了，那必定是廢代碼（永遠不會執行的）。

那么你能不能给点代码，就是可以随意什么版本的excel都可以导入的。有时涉及到单位每月上报时要导入，数百个单位每个月来报都要另存一下也挺麻烦的，上次你说OLE只是对excel的操作，并不能将Xls导进来。

能操作就能導進來。所謂操作，就是讀寫Excel文檔，讀得到Excel表單元格的數據就能寫進VFP的數據庫中。須知，Excel表格其實就是一個數據庫，每個單元格等效於表單上的文本框控件，讀的就是文本框中値，還不會寫進數據庫嗎？

你看1樓後半段代碼，REPLACE語句就是把讀到的數據寫入數據庫，已經實現你所要的功能了，那就是基本思路。我說它判斷Excel文檔的方法太機械了而已，那是針對Excel 97、2003的擴展名，Excel 2007的文檔擴展名是.xlsx。VFP是可以打開這些格式的Excel文檔的，但你看它判斷是不是Excel的代碼，就認為只有xls擴展名的才是Excel文檔，這就狹隘了。當然，如果你的程序打算只在Office 97、2003環境中運行，1樓那樣寫是沒問題的。

實際上，VFP是啓動了Excel程序，是直接用Excel處理自己的文檔，與VFP無關（Excel與VFP程序之間有協議，它們通過一種叫OLE的技術互相聯係，可以在VFP中操縱Excel，用Windows的任務管理器，可以看到有個隱藏的Excel進程在運行，那就是VFP啓動的）。所以這種操作手法，不需VFP與Office版本對應，事實上用VFP6打開Office 2010的文檔也沒有問題。

在網上查一下OLE技術的資料，可以瞭解更多。明白原理，才能明白程序應該怎麼寫。

[ 本帖最后由 TonyDeng 于 2011-7-6 18:02 编辑 ]

你想要通用的？也可以，有時間寫給你。你需要怎樣的功能，先說說看。

SET SAFETY OFF 
CLOSE DATABASES ALL 
Sheet2dbf("Test.xls", "my_Sheet", "new")
RETURN 

*---------------------------
* 從Excel表格中建立數據表並導入數據
* 參數：tcBook  -- Excel 工作簿名（須帶擴展名）
*       tcSheet -- 工作表名
*       tcTable -- 建立的數據庫名
* 說明：
* 1.在實際工作中，從Excel導入數據的需求，一般是一次性的，同樣的數據不應反復追加到數據庫中，故此處不檢驗數據的重覆。
* 2.建立的數據表結構佔用第1、2行，分別是字段名和數據類型（格式與CREATE TABLE語句對應）。
* 3.數據以{end}字樣結束（程序中應增加空行處理）。
* 4.日期型數據的處理，本例程並非適用一切環境，應根據實際環境調試。
*---------------------------
PROCEDURE Sheet2dbf(tcBook AS Character, tcSheet AS Character, tcTable AS Character)
    LOCAL loExcel AS Object 
    LOCAL laColumns[1,3]
    LOCAL lnFields AS Integer, lnIndex AS Integer, lcText AS Character, lnRow AS Integer, lnCol AS Integer
    LOCAL lcType AS Character
    LOCAL lcYear AS Character, lcMonth AS Character, lcDay AS Character
    
    loExcel = CREATEOBJECT("Excel.Application")
    WITH loExcel
        .WorkBooks.Open(FULLPATH(tcBook))
        .WorkSheets(tcSheet).Activate
        lcText = ""
        lnIndex = 1
        DO WHILE !EMPTY(ALLTRIM(.Cells(1, lnIndex).Text))
            DIMENSION laColumns[lnIndex,3]
            laColumns[lnIndex,1] = ALLTRIM(.Cells(1, lnIndex).Text)
            laColumns[lnIndex,2] = ALLTRIM(.Cells(2, lnIndex).Text)
            laColumns[lnIndex,3] = lnIndex
            lcText = lcText + laColumns[lnIndex,1] + " " + laColumns[lnIndex,2] + ", "
            lnIndex = lnIndex + 1
        ENDDO 
        lcText = LEFT(lcText, LEN(lcText) - 2)
        CREATE TABLE (tcTable) (&lcText)
        lnFields = ALEN(laColumns,1)
        lnRow = 3
        DO WHILE UPPER(.Cells(lnRow,1).Text) != "{END}"
            SELECT (tcTable)
            APPEND BLANK 
            FOR lnCol = 1 TO lnFields
                lcType = UPPER(LEFT(laColumns[lnCol,2],1))
                DO CASE 
                    CASE INLIST(lcType, "C", "M")
                        REPLACE (laColumns[lnCol,1]) WITH .Cells(lnRow, laColumns[lnCol,3]).Text
                    CASE INLIST(lcType, "N", "B", "F", "I")
                        REPLACE (laColumns[lnCol,1]) WITH .Cells(lnRow, laColumns[lnCol,3]).Value
                    CASE lcType == "D"
                        cText = ALLTRIM(.Cells(lnRow, laColumns[lnCol,3]).Text)
                        lcYear = LEFT(cText, 4)
                        lcMonth = SUBSTR(cText, 6, 2)
                        lcDay = RIGHT(cText, 2)
                        cText = "{^" + lcYear + "-" + lcMonth + "-" + lcDay + "}"
                        REPLACE (laColumns[lnCol,1]) WITH &cText
                    CASE lcType == "L"
                        REPLACE (laColumns[lnCol,1]) WITH (.Cells(lnRow, laColumns[lnCol,3]).Text != "0")
                ENDCASE 
            NEXT 
            lnRow = lnRow + 1
        ENDDO 
        USE IN (tcTable)
        .Quit
    ENDWITH 
    RELEASE loExcel
    
ENDPROC 

測試Excel附件：


[ 本帖最后由 TonyDeng 于 2011-7-7 19:51 编辑 ]

收到的鲜花

• qshuju 于 2011-07-11 18:07 送鲜花  3朵   附言：感谢呀。我还没看代码，先谢谢你，稍后再学 ...

不同意3楼意见.

嗯，GETFILE()手動時可以由用戶改變文件類型爲*.*，此時那段代碼會用到，不算廢代碼。

看到就快晕了，给我点时间，明天我把每一行加注释，然后贴上来，看我读的对不对。
顺便问个问题，昨天说的联合索引。在成绩表中以学号加课程名作为主索引方便查询，我新建一个XHKC的索引名，表达式里面应该怎么写？我写的是"xh"+"kch",可是它提示不是唯一的。

[ 本帖最后由 lyxc34 于 2011-7-10 23:38 编辑 ]