让你熟练掌握VB.NET Excel文件运用
创始人
2024-06-10 05:20:19
0

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

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

  1. view plaincopy to clipboardprint?  
  2. Option Explicit   
  3. Public Function MergeXlsFile(ByVal strPath As String, Optional ByVal SheetCount As Byte = 1) As Boolean  
  4. Dim i As Integer  
  5. Dim strSrcFile As String  
  6. Dim nRows As Long, nCols As Long, nSheets As Byte, nNewRows() As Integer  
  7. Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object  
  8. On Error Resume Next  
  9. If Right(strPath, 1) <> "\" Then strPathstrPath = strPath & "\"   
  10. '如果需要合并文件中的工作表数量小于1则退出   
  11. If SheetCount < 1 Then Exit Function  
  12. '删除掉该路径下原来的合并文件   
  13. If Dir(strPath & "合并后的文件.xls") <> "" Then Kill strPath & "合并后的文件.xls"  
  14. '获得第1个XLS文件   
  15. strSrcFile = Dir(strPath & "*.xls")   
  16. '如果文件不存在则退出   
  17. If Len(strSrcFile) = 0 Then Exit Function  
  18. '创建一个Excel实例   
  19. Set xlApp = CreateObject("Excel.Application")   
  20. '新建一个工作簿   
  21. Set xlNewBook = xlApp.Workbooks.Add   
  22. '调整新建工作簿里工作表的数量   
  23. ReDim nNewRows(1 To SheetCount)   
  24. For i = 1 To SheetCount - xlNewBook.Sheets.Count   
  25. xlNewBook.Sheets.Add , xlNewBook.Sheets(xlNewBook.Sheets.Count)   
  26. Next  
  27. '循环查找当前路径下的所有XLS文件   
  28. Do  
  29. '打开找到的XLS文件   
  30. Set xlSrcBook = xlApp.Workbooks.Open(strPath & strSrcFile)   
  31. '循环复制源XLS文件里的工作表   
  32. nSheets = IIf(xlSrcBook.Sheets.Count < SheetCount, xlSrcBook.Sheets.Count, SheetCount)   
  33. For i = 1 To nSheets   
  34. Set xlSheet = xlSrcBook.Sheets(i)   
  35. '获得源XLS文件中第i个工作表实际数据的行列数   
  36. nRows = xlSheet.UsedRange.Rows.Count   
  37. nCols = xlSheet.UsedRange.Columns.Count   
  38. '使用范围对象粘贴源XLS文件数据到合并结果文件中   
  39. Set xlRange = xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(nRows, nCols))   
  40. xlRange.Select  
  41. xlRange.Copy   
  42. xlNewBook.Sheets(i).Cells(nNewRows(i) + 1, 1).PasteSpecial &HFFFFEFF8   
  43. '保存合并结果文件中第i个工作表的行数   
  44. nNewRows(i) = xlNewBook.Sheets(1).UsedRange.Rows.Count   
  45. Next  
  46. '关闭打开的源XLS文件   
  47. xlSrcBook.Close   
  48. '继续查找下一个XLS文件   
  49. strSrcFile = Dir()   
  50. Loop Until Len(strSrcFile) = 0   
  51. '保存并关闭合并结果文件   
  52. xlNewBook.SaveAs strPath & "合并后的文件.xls"  
  53. xlNewBook.Close   
  54. '退出Excel实例   
  55. xlApp.Quit   
  56. '释放资源   
  57. Erase nNewRows   
  58. Set xlRange = Nothing 
  59. Set xlSheet = Nothing 
  60. Set xlNewBook = Nothing 
  61. Set xlSrcBook = Nothing 
  62. If Err.Number = 0 Then MergeXlsFile = True 
  63. End Function  
  64. Option Explicit  
  65.  
  66. Public Function MergeXlsFile(ByVal strPath As String, Optional ByVal SheetCount As Byte = 1) As Boolean  
  67. Dim i As Integer  
  68. Dim strSrcFile As String  
  69. Dim nRows As Long, nCols As Long, nSheets As Byte, nNewRows() As Integer  
  70. Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object  
  71.  
  72. On Error Resume Next  
  73. If Right(strPath, 1) <> "\" Then strPathstrPath = strPath & "\"  
  74. '如果需要合并文件中的工作表数量小于1则退出  
  75. If SheetCount < 1 Then Exit Function  
  76. '删除掉该路径下原来的合并文件  
  77. If Dir(strPath & "合并后的文件.xls") <> "" Then Kill strPath & "合并后的文件.xls"  
  78. '获得第1个XLS文件  
  79. strSrcFile = Dir(strPath & "*.xls")  
  80. '如果文件不存在则退出  
  81. If Len(strSrcFile) = 0 Then Exit Function  
  82. '创建一个Excel实例  
  83. Set xlApp = CreateObject("Excel.Application")  
  84. '新建一个工作簿  
  85. Set xlNewBook = xlApp.Workbooks.Add  
  86. '调整新建工作簿里工作表的数量  
  87. ReDim nNewRows(1 To SheetCount)  
  88. For i = 1 To SheetCount - xlNewBook.Sheets.Count  
  89. xlNewBook.Sheets.Add , xlNewBook.Sheets(xlNewBook.Sheets.Count)  
  90. Next  
  91. '循环查找当前路径下的所有XLS文件  
  92. Do  
  93. '打开找到的XLS文件  
  94. Set xlSrcBook = xlApp.Workbooks.Open(strPath & strSrcFile)  
  95. '循环复制源XLS文件里的工作表  
  96. nSheets = IIf(xlSrcBook.Sheets.Count < SheetCount, xlSrcBook.Sheets.Count, SheetCount)  
  97. For i = 1 To nSheets  
  98. Set xlSheet = xlSrcBook.Sheets(i)  
  99. '获得源XLS文件中第i个工作表实际数据的行列数  
  100. nRows = xlSheet.UsedRange.Rows.Count  
  101. nCols = xlSheet.UsedRange.Columns.Count  
  102. '使用范围对象粘贴源XLS文件数据到合并结果文件中  
  103. Set xlRange = xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(nRows, nCols))  
  104. xlRange.Select  
  105. xlRange.Copy  
  106. xlNewBook.Sheets(i).Cells(nNewRows(i) + 1, 1).PasteSpecial &HFFFFEFF8  
  107. '保存合并结果文件中第i个工作表的行数  
  108. nNewRows(i) = xlNewBook.Sheets(1).UsedRange.Rows.Count  
  109. Next  
  110. '关闭打开的源XLS文件  
  111. xlSrcBook.Close  
  112. '继续查找下一个XLS文件  
  113. strSrcFile = Dir()  
  114. Loop Until Len(strSrcFile) = 0  
  115. '保存并关闭合并结果文件  
  116. xlNewBook.SaveAs strPath & "合并后的文件.xls"  
  117. xlNewBook.Close  
  118. '退出Excel实例  
  119. xlApp.Quit  
  120. '释放资源  
  121. Erase nNewRows  
  122. Set xlRange = Nothing 
  123. Set xlSheet = Nothing 
  124. Set xlNewBook = Nothing 
  125. Set xlSrcBook = Nothing 
  126. If Err.Number = 0 Then MergeXlsFile = True 
  127. End Function   

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

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

【编辑推荐】

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

相关内容

热门资讯

如何允许远程连接到MySQL数... [[277004]]【51CTO.com快译】默认情况下,MySQL服务器仅侦听来自localhos...
如何利用交换机和端口设置来管理... 在网络管理中,总是有些人让管理员头疼。下面我们就将介绍一下一个网管员利用交换机以及端口设置等来进行D...
施耐德电气数据中心整体解决方案... 近日,全球能效管理专家施耐德电气正式启动大型体验活动“能效中国行——2012卡车巡展”,作为该活动的...
Windows恶意软件20年“... 在Windows的早期年代,病毒游走于系统之间,偶尔删除文件(但被删除的文件几乎都是可恢复的),并弹...
20个非常棒的扁平设计免费资源 Apple设备的平面图标PSD免费平板UI 平板UI套件24平图标Freen平板UI套件PSD径向平...
德国电信门户网站可实时显示全球... 德国电信周三推出一个门户网站,直观地实时提供其安装在全球各地的传感器网络检测到的网络攻击状况。该网站...
着眼MAC地址,解救无法享受D... 在安装了DHCP服务器的局域网环境中,每一台工作站在上网之前,都要先从DHCP服务器那里享受到地址动...
为啥国人偏爱 Mybatis,... 关于 SQL 和 ORM 的争论,永远都不会终止,我也一直在思考这个问题。昨天又跟群里的小伙伴进行...