PB6.5导入Excel文件

integer ll_rows,ll_cells,result
//定义一个OLEObject连接指定Excel文件
OLEOBJECT MyOleObject,objectWorkBook
MyOleObject = Create OLEObject
integer value
string excelName,name,curdir

 

curdir=Space(256) 
ulong bufferLen = 256
//为字符缓冲区开辟内存空间
//获取当前工作目录，避免GetFileOpenName函数更改当前工作目录后连接不上数据库
GetCurrentDirectoryA(bufferLen,curdir)
//需要定义外部函数，pb6.5没有获取当前工作目录的函数

//FUNCTION ulong GetCurrentDirectoryA(ulong BufferLen, ref string currentdir) LIBRARY "kernel32.dll"
value = GetFileOpenName("Select File",excelName,name,"Excel Files (*.xls),*.xls")
if value <> 1 then
    messagebox("提示：","打开文件失败!")
    return
end if

result = MyOleObject.ConnectToObject(excelName)
//判断是否正确连接，连接成功后返回0
if result <> 0 then
    messagebox("提示：","连接excel文件失败")
    return
end if
//成功连接excel文件
//读取excel文件中所有单元格的信息，填充到datawindow中
objectWorkBook = MyOleObject.Worksheets(1)
ll_cells = objectWorkBook.UsedRange.columns.Count
ll_rows = objectWorkBook.UsedRange.rows.Count
if ll_rows < 2 then
    messagebox("","文件为空，无须导入")
    return
end if
int i,j,ll_currentRowCount,temp_i
string ls_value
ll_currentRowCount = dw_1.RowCount();
ll_rows = ll_rows + ll_currentRowCount
dw_1.accepttext()

//循环读取excel中的数据
FOR i = ll_currentRowCount + 1 TO ll_rows - 1
    if i = 0 then
        i = 1
    end if
    temp_i = i - ll_currentRowCount + 1
    //判断是否重复记录，若是重复记录则提醒用户此记录已经存在，请核对编码
    myoleobject.application.workbooks(1).worksheets(1).cells(temp_i,1).copy
    ls_value   =  clipboard()
//    test = blob(clipboard())
    ls_value = mid(ls_value,1,len(ls_value) - 2)
    if len(trim(ls_value)) = 0 or ls_value = ' ' then
        continue
    else
        long ll_found
        ll_found = dw_1.Find("code = '"+ls_value+"'",1,dw_1.RowCount())
        if ll_found > 0 then
            messagebox("提示：","编号为："+ls_value+"的药品已经存在，无法导入此记录，请检查")
        else
            dw_1.InsertRow (0)
            FOR j = 1 TO ll_cells
                //将指定单元格的值绑定到datawindow

                //由于pb6.5对汉字的支持不高，直接取value会有乱码，这里利用粘贴版的方式取值
                myoleobject.application.workbooks(1).worksheets(1).cells(temp_i,j).copy
                ls_value   =   clipboard()

                //注意：利用粘贴版模式复制excel的单元格内容时，会自动在字符串的尾部添加长度为2的tab空格，并且trim去不掉此空格

                //这里就是去掉这两个空格键
                ls_value = mid(ls_value,1,len(ls_value) - 2)
                dw_1.SetItem(i,j,ls_value)   
            NEXT
       end if
   end if
NEXT
messagebox("","导入成功！")
myoleobject.Application.Quit
myoleobject.DisConnectObject()
DESTROY myoleobject

//这里定义一个外部程序，将当前工作目录修改回来
//FUNCTION boolean SetCurrentDirectoryA(ref string lpsdir) LIBRARY "kernel32.dll"
SetCurrentDirectoryA(curdir)