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

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

成都创新互联公司2013年至今，先为墨江等服务建站，墨江等地企业，进行企业商务咨询服务。为墨江企业网站制作PC+手机+微官网三网同步一站式服务解决您的所有建站问题。

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

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

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

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

当前标题：让你熟练掌握VB.NETExcel文件运用
网页路径：http://www.shufengxianlan.com/qtweb/news49/228649.html

网站建设、网络推广公司-创新互联，是专注品牌与效果的网站制作，网络营销seo公司；服务项目有等

广告

声明：本网站发布的内容（图片、视频和文字）以用户投稿、用户转载内容为主，如果涉及侵权请尽快告知，我们将会在第一时间删除。文章观点不代表本网站立场，如需处理请联系客服。电话：028-86922220；邮箱：631063699@qq.com。内容未经允许不得转载，或转载时需注明来源： 创新互联

猜你还喜欢下面的内容

用户体验知识

同城分类信息

网站建设公司　　 　公司网站建设　　 　内江服务器托管　　 　成都高电机柜租用　　 　网站推广公司　　 　响应式网站建设方案　　 　微商城开发　　 　木包装箱　　 　域名注册　　 　电信内江机房　　 　企业网站建设　　 　成都广告设计公司　　 　安防网站建设方案　　 　迷你发光字　　 　重庆服务器托管　　 　电信成都枢纽中心　　 　平城网站运维　　 　自贡电信机房　　 　成都云服务器　　 　成都全网营销推广