51Testing软件测试论坛

 找回密码
 (注-册)加入51Testing

QQ登录

只需一步,快速开始

微信登录,快人一步

查看: 3547|回复: 3
打印 上一主题 下一主题

[原创] 一个拷贝excel文件的函数(解决datatable.import出错的问题)

[复制链接]

该用户从未签到

跳转到指定楼层
1#
发表于 2007-10-29 16:35:12 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
原来问过从excel里import data经常出错的问题,一直没找到好的解决办法。所以就写了个函数用代码重写文件,重写过的以后再导入就没有问题了,看到大家有不少和我遇到同样的问题,那么把函数共享下,希望对大家有用。


CopyDataxls "C:\Autotest\aa.xls", "C:\Autotest\data\aa.xls"
-------------------------
Public Function CopyDataXls(byval OrigFile,byval DestFile)
        Dim ExcelApp
        Dim OrigSheet,DestSheet
        Dim OrigWorkbook,DestWorkbook
        Dim SheetCnt,ColumnCnt,RowCnt
        Dim n,i,j,tempValue
       
        Set ExcelApp = CreateObject("Excel.Application")
        ExcelApp.Visible = True
        Set OrigWorkbook = ExcelApp.Workbooks.Open(OrigFile)
        Set DestWorkbook = ExcelApp.Workbooks.Add()
        DestWorkbook.sheets(3).delete
        DestWorkbook.sheets(2).delete
        SheetCnt = OrigWorkbook.sheets.count
       
        For n = 1 to SheetCnt
         Set OrigSheet = OrigWorkbook.sheets.Item(n)
         If n <> 1  Then
                DestWorkbook.sheets.add ,DestWorkbook.sheets.item(n-1)
         End If
         DestWorkbook.sheets(n).name = OrigSheet.name
         Set DestSheet = DestWorkbook.sheets.Item(n)
         ColumnCnt = OrigSheet.Range("A1").CurrentRegion.Columns.Count
         RowCnt = OrigSheet.Range("A1").CurrentRegion.Rows.Count
       
         For i = 1 to RowCnt
                 For j = 1 to ColumnCnt
                        DestSheet.cells(i,j) = OrigSheet.cells(i,j)
                 Next
         Next
        Next
       
        On Error Resume Next
        ExcelApp.DisplayAlerts = False
        Set fso = CreateObject("Scripting.FileSystemObject")
        fso.DeleteFile DestFile
        set fso = nothing
        On Error GoTo 0
       
        DestWorkbook.saveas DestFile
        ExcelApp.Quit
        Set ExcelApp = Nothing
End Function
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏
回复

使用道具 举报

该用户从未签到

2#
发表于 2007-10-29 17:01:55 | 只看该作者
还是习惯通过函数访问Excel,这样保存运行结果也比较方便。如果是Import到DataTable中,那运行结果最终还是要导出来的。。。
回复 支持 反对

使用道具 举报

该用户从未签到

3#
发表于 2007-10-31 09:14:03 | 只看该作者

回复 1# 的帖子

1#好。
我将你提供的代码粘到Expert  View中,执行 到  DestWorkbook.saveas DestFile这步出错。
弹出错误提示框Run Error:要保存的文件不能与已打开的文档崇明。有一个打开的文档使用了当前指定的名称。请为工作波选用其他明晨,或先关闭打开的同名文档。          事实上文件名并没有重名。         谢谢o(∩_∩)o...
回复 支持 反对

使用道具 举报

该用户从未签到

4#
 楼主| 发表于 2007-10-31 12:28:45 | 只看该作者
函数有两个参数,origFile和DestFile 是不能一样的,你检查一下吧
回复 支持 反对

使用道具 举报

本版积分规则

关闭

站长推荐上一条 /1 下一条

小黑屋|手机版|Archiver|51Testing软件测试网 ( 沪ICP备05003035号 关于我们

GMT+8, 2024-5-9 11:31 , Processed in 0.091474 second(s), 27 queries .

Powered by Discuz! X3.2

© 2001-2024 Comsenz Inc.

快速回复 返回顶部 返回列表