51Testing软件测试论坛

标题: 一个拷贝excel文件的函数（解决datatable.import出错的问题） [打印本页]

作者: danmy 时间: 2007-10-29 16:35
标题: 一个拷贝excel文件的函数（解决datatable.import出错的问题）
原来问过从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

作者: hsjzfling 时间: 2007-10-29 17:01
还是习惯通过函数访问Excel，这样保存运行结果也比较方便。如果是Import到DataTable中，那运行结果最终还是要导出来的。。。

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

作者: danmy 时间: 2007-10-31 12:28
函数有两个参数，origFile和DestFile 是不能一样的，你检查一下吧

欢迎光临 51Testing软件测试论坛 (http://bbs.51testing.com/)