讓你熟練掌握VB.NET Excel文件運用
作者:佚名
這里為你介紹一個簡單而實用的合并VB.NET Excel文件的函數,能夠將多個XLS文件中指定數量的工作表自動合并到一個XLS文件里。
這個是我在工作中編寫的代碼中的一個小篇章,拿出來和大家分享一下,一個簡單而實用的合并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
【編輯推薦】
責任編輯:田樹
來源:
博客