Board logo

标题: [问题求助] 求助VBS为什么最后保存为txt文件时首行是空白行 [打印本页]

作者: superman    时间: 2021-6-5 12:39     标题: 求助VBS为什么最后保存为txt文件时首行是空白行

  1. Dim strPath
  2. Dim arr, brr, t
  3. If wscript.Arguments.Count = 0 Then
  4.     MsgBox "拖拽Excel文件到本vbs文件", 0, "提示"
  5. End If
  6. For jb = 0 To wscript.Arguments.Count - 1
  7.     strPath = wscript.Arguments(jb)
  8.     MsgBox  "将要导出" & strPath, vbOKCancel, "提示"
  9. Next
  10. Set oExcel = CreateObject("Excel.Application")
  11. Set oWorkBook = oExcel.Workbooks.Open(strPath)
  12. Set oSheet = oWorkBook.Sheets(1)
  13. arr = oSheet.UsedRange.Range("B1:C" & oSheet.UsedRange.Rows.Count)
  14. ReDim brr(UBound(arr, 1))
  15. For a = 0 To UBound(arr, 1)
  16.     brr(a) = arr(a, 1)
  17.     For b = 2 To UBound(arr, 2)
  18.         brr(a) = arr(a, b) & "," & brr(a)
  19. 'brr(a) =  brr(a) & "," & arr(a, b)
  20.     Next
  21. Next
  22. Write strpath & ".txt" , Join(brr, vbCrLf)
  23. Set oSheet = Nothing
  24. oWorkBook.Close False
  25. Set oWorkBook = Nothing
  26. oExcel.Quit
  27. Sub Write(strName,str)
  28.     Dim oFSO, oFile
  29.     Set oFSO = CreateObject("Scripting.FileSystemObject")
  30.     Set oFile = oFSO.OpenTextFile(strName, 2, True) '不存在则创建,强制覆盖
  31.     oFile.Writeline str
  32.     oFile.Close
  33.     Set oFile = Nothing
  34.     Set oFSO = Nothing
  35. End Sub
  36. reReplace(str ,"^" & vbcrlf,"")
  37. Function reReplace(str,patrn, replStr)
  38.     Dim regEx, str1
  39.     Set regEx = New RegExp
  40.     regEx.Pattern = patrn
  41.     regEx.IgnoreCase = True
  42.     regEx.Global = false
  43.     reReplace = regEx.Replace(str, replStr)
  44. End Function
复制代码

作者: newswan    时间: 2021-6-5 12:56

本帖最后由 newswan 于 2021-6-5 13:38 编辑

brr 从 0 开始
  1. For a = 0 To UBound(arr, 1)
  2.     brr(a) = arr(a, 1)
  3.     For b = 2 To UBound(arr, 2)
  4.         brr(a) = arr(a, b) & "," & brr(a)
  5. 'brr(a) =  brr(a) & "," & arr(a, b)
  6.     Next
  7. Next
复制代码

作者: superman    时间: 2021-6-5 13:13

本帖最后由 superman 于 2021-6-5 13:19 编辑

回复 2# newswan


    修改后第15行报错,提示字符13 缺少")" 老师能看看是哪里不对吗
作者: newswan    时间: 2021-6-5 13:36

本帖最后由 newswan 于 2021-6-5 13:51 编辑

回复 3# superman


    vbs 不熟 ,刚才看了下,vbs 数组下标只能从 0 开始

话说,用 arr brr 好奇怪,不如 arr1 arr2
作者: superman    时间: 2021-6-5 13:51

回复 2# newswan


    还是报错,行16,字符5,错误:下标越界:”0“
作者: newswan    时间: 2021-6-5 14:53

本帖最后由 newswan 于 2021-6-5 14:56 编辑

全部还原
  1. str = Join(brr, vbCrLf)
复制代码
然后 删除 str 前2个字符
作者: newswan    时间: 2021-6-5 15:14

本帖最后由 newswan 于 2021-6-5 15:35 编辑
  1. dim arr
  2. redim arr(5)
  3. for i= 0 to 5
  4. arr(i)=i
  5. next
  6. Write "v2.txt" , join(arr,vbCrLf)
  7. Sub Write(strName,str)
  8.     Dim oFSO, oFile
  9.     Set oFSO = CreateObject("Scripting.FileSystemObject")
  10.     Set oFile = oFSO.OpenTextFile(strName, 2, True)
  11.     oFile.Writeline str
  12.     oFile.Close
  13.     Set oFile = Nothing
  14.     Set oFSO = Nothing
  15. End Sub
复制代码
用这个测试,writeline str 后面不需要加 vbcrlf
如果brr(0) 没有值,那么前面会多一个空行

去掉开始的空行
  1. reReplace(str ,"^" & vbcrlf,"")
  2. Function reReplace(str,patrn, replStr)
  3.     Dim regEx, str1
  4.     Set regEx = New RegExp
  5.     regEx.Pattern = patrn
  6.     regEx.IgnoreCase = True
  7.     regEx.Global = false
  8.     reReplace = regEx.Replace(str, replStr)
  9. End Function
复制代码

作者: superman    时间: 2021-6-5 16:42

回复 7# newswan


   我运行还是要报错,不知为啥
论坛传不了附件,附上测试数据
https://wwr.lanzoui.com/iIZWQptnkif
作者: newswan    时间: 2021-6-5 17:49

  1. Dim strPath
  2. Dim arr, arrLine, t
  3. If wscript.Arguments.Count = 0 Then
  4.     MsgBox "拖拽Excel文件到本vbs文件", 0, "提示"
  5. End If
  6. For jb = 0 To wscript.Arguments.Count - 1
  7.     strPath = wscript.Arguments(jb)
  8.     MsgBox  "将要导出" & strPath, vbOKCancel, "提示"
  9. Next
  10. Set oExcel = CreateObject("Excel.Application")
  11. Set oWorkBook = oExcel.Workbooks.Open("C:\Users\admin\Desktop\test\d.xlsx")
  12. Set oSheet = oWorkBook.Sheets(1)
  13. arr = oSheet.UsedRange.Range("B1:C" & oSheet.UsedRange.Rows.Count)
  14. Set oSheet = Nothing
  15. oWorkBook.Close False
  16. Set oWorkBook = Nothing
  17. oExcel.Quit
  18. ReDim arrLine(UBound(arr, 1)-1)
  19. For a = 1 To UBound(arr, 1)
  20.     arrLine(a-1) = arr(a, 2) & "," & arr(a,1)
  21. Next
  22. str = Join(arrLine, vbCrLf)
  23. Write strpath & ".txt" , Join(arrLine, vbCrLf)
  24. Sub Write(strName,str)
  25.     Dim oFSO, oFile
  26.     Set oFSO = CreateObject("Scripting.FileSystemObject")
  27.     Set oFile = oFSO.OpenTextFile(strName, 2, True) '不存在则创建,强制覆盖
  28.     oFile.Writeline str
  29.     oFile.Close
  30.    
  31.     Set oFile = Nothing
  32.     Set oFSO = Nothing
  33. End Sub
复制代码





欢迎光临 批处理之家 (http://bathome.net./) Powered by Discuz! 7.2