[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[转贴] VBS把.CSV格式转成.XLS格式(转)

[code]
'W_Path = createobject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path

str = left(wscript.scriptfullname,instrrev(wscript.scriptfullname,"\")-1) '获取当前路径
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(str+"\RESULT.CSV") Then
   If fso.FileExists(str+"\RESULT.xls") Then
      fso.DeleteFile str+"\RESULT.xls", true
   End If
   strCsvFile = str+"\RESULT.CSV"   
   set objExcel = CreateObject("Excel.Application")
   set Csvbook = objExcel.Workbooks.open(strCsvFile) '打开CSV文件
   set Csvsheet = Csvbook.Worksheets(1) '取CSV文件的sheet
   set Excelbook = objExcel.Workbooks.Add    '新建EXCEL文件
   set Excelsheet = Excelbook.Worksheets(1) '添加工作页
   '获取CSV第一行列数
   i=1
   j=1
   do while not isempty(Csvsheet.cells(i,j).value)
      j=j+1
   loop
   k=j
   '以下为复制数据
   do while not isempty(Csvsheet.cells(i,1).value)
      j=1
      do while j<k
         Excelsheet.cells(i,j).value=Csvsheet.cells(i,j).value
         j=j+1
      loop
      i=i+1
   loop
   Excelbook.SaveAs str+"\RESULT.xls" '保存xls文件
   wscript.echo str+"\RESULT.xls"+" 创建成功!"
   '释放资源
   Excelbook.close
   Csvbook.close(false) '不保存对CSV文件的修改
   objExcel.quit
else
   wscript.echo str+"\export.csv"+" 不存在!"
end if
WScript.quit
[/code]
命令行交流群:25440765
思科网络技术群:23326892

自己做个备份,网上很难找到直接有效的,只有如何建立excel对象的连接和操作,结合在一起就不懂了~
命令行交流群:25440765
思科网络技术群:23326892

TOP

我也写一个
  1. '将 Csv 文件拖入此文件图标即生成同名的 Xls 文件
  2. CsvFile = WScript.Arguments(0)
  3. Set ExcelApp = CreateObject("Excel.Application")
  4. Set fso = CreateObject("Scripting.FileSystemObject")
  5. If UCase(Right(CsvFile,4)) = ".CSV" Then
  6.   XlsFile = Left(CsvFile,instrrev(CsvFile,".")) & "XLS"
  7.   Set CsvBook  = ExcelApp.Workbooks.open(CsvFile)
  8.   Set CsvSheet = CsvBook.Worksheets(1)
  9.   Set XlsBook  = ExcelApp.Workbooks.Add
  10.   Set XlsSheet = XlsBook.Worksheets(1)
  11.   CsvSheet.UsedRange.Copy
  12.   XlsSheet.Range("A1").PasteSpecial
  13.   ExcelApp.DisplayAlerts = False
  14.   XlsBook.SaveAs(XlsFile)
  15.   XlsBook.Close
  16.   CsvBook.Close(False)
  17. End If
  18. WScript.Echo ".Csv 转 .Xls 完成!"
  19. WScript.Quit
复制代码
如无特别说明,代码测试环境均为 XP SP3

TOP

  1. Dim filespec : filespec = WScript.Arguments(0)
  2. 'CSV格式
  3. Const xlCSV = 6
  4. '当前版本EXCEL默认格式
  5. Const xlWorkbookDefault = 51
  6. '普通
  7. Const xlWorkbookNormal = -4143
  8. RecognizedFormatConvert filespec, xlCSV
  9. RecognizedFormatConvert filespec, xlWorkbookDefault
  10. RecognizedFormatConvert filespec, xlWorkbookNormal
  11. Sub RecognizedFormatConvert(sAnyFile, lXLFormat)
  12. Dim excel, fso, f, fname
  13. Set excel = CreateObject("Excel.Application")
  14. excel.Visible = False
  15. excel.DisplayAlerts = False
  16. Set fso = CreateObject("Scripting.FileSystemObject")
  17. Set f = fso.GetFile(sAnyFile)
  18. fName = Left(f.Name, InStrRev(f.Name, ".") - 1)
  19. excel.Workbooks.Open f.Path, 0, True
  20. excel.Workbooks(1).SaveAs fso.BuildPath(f.ParentFolder.Path, fName & "_New"), lXLFormat
  21. excel.Workbooks.Close
  22. excel.Quit
  23. End Sub
复制代码

TOP

回复 3# cutebe

请问一下,转换CSV文件有中文,转换后,中文还是乱码的,请问下这个怎么处理
谢谢

TOP

矮油、、非常感谢楼主的分享!支持...

TOP

返回列表