让你熟练掌握VB.NET Excel文件运用

这个是我在工作中编写的代码中的一个小篇章，拿出来和大家分享一下，一个简单而实用的合并VB.NET Excel文件的函数，能够将多个XLS文件中指定数量的工作表自动合并到一个XLS文件里。当然，如果只是数据合并，则使用ADO就可以实现，但如果要保留表格格式，则恐怕只能使用俺的方法了。

一、VB.NET Excel文件函数代码：

view plaincopy to clipboardprint?  
Option Explicit   
Public Function MergeXlsFile(ByVal strPath As String, Optional ByVal SheetCount As Byte = 1) As Boolean  
Dim i As Integer  
Dim strSrcFile As String  
Dim nRows As Long, nCols As Long, nSheets As Byte, nNewRows() As Integer  
Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object  
On Error Resume Next  
If Right(strPath, 1) <> "\" Then strPathstrPath = strPath & "\"   
'如果需要合并文件中的工作表数量小于1则退出   
If SheetCount < 1 Then Exit Function  
'删除掉该路径下原来的合并文件   
If Dir(strPath & "合并后的文件.xls") <> "" Then Kill strPath & "合并后的文件.xls"  
'获得第1个XLS文件   
strSrcFile = Dir(strPath & "*.xls")   
'如果文件不存在则退出   
If Len(strSrcFile) = 0 Then Exit Function  
'创建一个Excel实例   
Set xlApp = CreateObject("Excel.Application")   
'新建一个工作簿   
Set xlNewBook = xlApp.Workbooks.Add   
'调整新建工作簿里工作表的数量   
ReDim nNewRows(1 To SheetCount)   
For i = 1 To SheetCount - xlNewBook.Sheets.Count   
xlNewBook.Sheets.Add , xlNewBook.Sheets(xlNewBook.Sheets.Count)   
Next  
'循环查找当前路径下的所有XLS文件   
Do  
'打开找到的XLS文件   
Set xlSrcBook = xlApp.Workbooks.Open(strPath & strSrcFile)   
'循环复制源XLS文件里的工作表   
nSheets = IIf(xlSrcBook.Sheets.Count < SheetCount, xlSrcBook.Sheets.Count, SheetCount)   
For i = 1 To nSheets   
Set xlSheet = xlSrcBook.Sheets(i)   
'获得源XLS文件中第i个工作表实际数据的行列数   
nRows = xlSheet.UsedRange.Rows.Count   
nCols = xlSheet.UsedRange.Columns.Count   
'使用范围对象粘贴源XLS文件数据到合并结果文件中   
Set xlRange = xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(nRows, nCols))   
xlRange.Select  
xlRange.Copy   
xlNewBook.Sheets(i).Cells(nNewRows(i) + 1, 1).PasteSpecial &HFFFFEFF8   
'保存合并结果文件中第i个工作表的行数   
nNewRows(i) = xlNewBook.Sheets(1).UsedRange.Rows.Count   
Next  
'关闭打开的源XLS文件   
xlSrcBook.Close   
'继续查找下一个XLS文件   
strSrcFile = Dir()   
Loop Until Len(strSrcFile) = 0   
'保存并关闭合并结果文件   
xlNewBook.SaveAs strPath & "合并后的文件.xls"  
xlNewBook.Close   
'退出Excel实例   
xlApp.Quit   
'释放资源   
Erase nNewRows   
Set xlRange = Nothing 
Set xlSheet = Nothing 
Set xlNewBook = Nothing 
Set xlSrcBook = Nothing 
If Err.Number = 0 Then MergeXlsFile = True 
End Function  
Option Explicit  
 
Public Function MergeXlsFile(ByVal strPath As String, Optional ByVal SheetCount As Byte = 1) As Boolean  
Dim i As Integer  
Dim strSrcFile As String  
Dim nRows As Long, nCols As Long, nSheets As Byte, nNewRows() As Integer  
Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object  
 
On Error Resume Next  
If Right(strPath, 1) <> "\" Then strPathstrPath = strPath & "\"  
'如果需要合并文件中的工作表数量小于1则退出  
If SheetCount < 1 Then Exit Function  
'删除掉该路径下原来的合并文件  
If Dir(strPath & "合并后的文件.xls") <> "" Then Kill strPath & "合并后的文件.xls"  
'获得第1个XLS文件  
strSrcFile = Dir(strPath & "*.xls")  
'如果文件不存在则退出  
If Len(strSrcFile) = 0 Then Exit Function  
'创建一个Excel实例  
Set xlApp = CreateObject("Excel.Application")  
'新建一个工作簿  
Set xlNewBook = xlApp.Workbooks.Add  
'调整新建工作簿里工作表的数量  
ReDim nNewRows(1 To SheetCount)  
For i = 1 To SheetCount - xlNewBook.Sheets.Count  
xlNewBook.Sheets.Add , xlNewBook.Sheets(xlNewBook.Sheets.Count)  
Next  
'循环查找当前路径下的所有XLS文件  
Do  
'打开找到的XLS文件  
Set xlSrcBook = xlApp.Workbooks.Open(strPath & strSrcFile)  
'循环复制源XLS文件里的工作表  
nSheets = IIf(xlSrcBook.Sheets.Count < SheetCount, xlSrcBook.Sheets.Count, SheetCount)  
For i = 1 To nSheets  
Set xlSheet = xlSrcBook.Sheets(i)  
'获得源XLS文件中第i个工作表实际数据的行列数  
nRows = xlSheet.UsedRange.Rows.Count  
nCols = xlSheet.UsedRange.Columns.Count  
'使用范围对象粘贴源XLS文件数据到合并结果文件中  
Set xlRange = xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(nRows, nCols))  
xlRange.Select  
xlRange.Copy  
xlNewBook.Sheets(i).Cells(nNewRows(i) + 1, 1).PasteSpecial &HFFFFEFF8  
'保存合并结果文件中第i个工作表的行数  
nNewRows(i) = xlNewBook.Sheets(1).UsedRange.Rows.Count  
Next  
'关闭打开的源XLS文件  
xlSrcBook.Close  
'继续查找下一个XLS文件  
strSrcFile = Dir()  
Loop Until Len(strSrcFile) = 0  
'保存并关闭合并结果文件  
xlNewBook.SaveAs strPath & "合并后的文件.xls"  
xlNewBook.Close  
'退出Excel实例  
xlApp.Quit  
'释放资源  
Erase nNewRows  
Set xlRange = Nothing 
Set xlSheet = Nothing 
Set xlNewBook = Nothing 
Set xlSrcBook = Nothing 
If Err.Number = 0 Then MergeXlsFile = True 
End Function   

二、VB.NET Excel文件调用方法：

view plaincopy to clipboardprint?  
Sub main()   
If MergeXlsFile("c:\temp", 1) Then  
MsgBox "数据已成功合并!", vbInformation, "提示"  
Else  
MsgBox "数据合并失败!", vbCritical, "提示"  
End If  
End Sub  

【编辑推荐】

1. 详细分析VB.NET WithEvents
2. 浅析VB.NET局部静态变量
3. 原理分析VB.NET开发控件
4. 自己动手用代码实现VB.NET ListView加载数据
5. 详细介绍VB.NET MyClass