求助VBS为什么最后保存为txt文件时首行是空白行

superman

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

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

回复 2# newswan


    修改后第15行报错,提示字符13 缺少")" 老师能看看是哪里不对吗

newswan

回复 3# superman


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

话说，用 arr brr 好奇怪，不如 arr1 arr2

superman

回复 2# newswan


    还是报错，行16，字符5，错误：下标越界：”0“

newswan

全部还原

1. str = Join(brr, vbCrLf)

复制代码

然后 删除 str 前2个字符

newswan

1. 
   
2. dim arr
   
3. 
   
4. redim arr(5)
   
5. for i= 0 to 5
   
6. arr(i)=i
   
7. next
   
8. Write "v2.txt" , join(arr,vbCrLf)
   
9. 
   
10. Sub Write(strName,str)
    
11.     Dim oFSO, oFile
    
12.     Set oFSO = CreateObject("Scripting.FileSystemObject")
    
13.     Set oFile = oFSO.OpenTextFile(strName, 2, True)
    
14.     oFile.Writeline str
    
15.     oFile.Close
    
16.     Set oFile = Nothing
    
17.     Set oFSO = Nothing
    
18. 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

回复 7# newswan


   我运行还是要报错，不知为啥
论坛传不了附件，附上测试数据
https://wwr.lanzoui.com/iIZWQptnkif

newswan

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

复制代码