|
原来问过从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 |
|