标题: [问题求助] 求助VBS为什么最后保存为txt文件时首行是空白行 [打印本页]
作者: superman 时间: 2021-6-5 12:39 标题: 求助VBS为什么最后保存为txt文件时首行是空白行
- Dim strPath
- Dim arr, brr, t
- If wscript.Arguments.Count = 0 Then
- MsgBox "拖拽Excel文件到本vbs文件", 0, "提示"
- End If
- For jb = 0 To wscript.Arguments.Count - 1
- strPath = wscript.Arguments(jb)
- MsgBox "将要导出" & strPath, vbOKCancel, "提示"
- Next
- Set oExcel = CreateObject("Excel.Application")
- Set oWorkBook = oExcel.Workbooks.Open(strPath)
- Set oSheet = oWorkBook.Sheets(1)
- arr = oSheet.UsedRange.Range("B1:C" & oSheet.UsedRange.Rows.Count)
- ReDim brr(UBound(arr, 1))
- For a = 0 To UBound(arr, 1)
- brr(a) = arr(a, 1)
- For b = 2 To UBound(arr, 2)
- brr(a) = arr(a, b) & "," & brr(a)
- 'brr(a) = brr(a) & "," & arr(a, b)
- Next
- Next
- Write strpath & ".txt" , Join(brr, vbCrLf)
- Set oSheet = Nothing
- oWorkBook.Close False
- Set oWorkBook = Nothing
- oExcel.Quit
- Sub Write(strName,str)
- Dim oFSO, oFile
- Set oFSO = CreateObject("Scripting.FileSystemObject")
- Set oFile = oFSO.OpenTextFile(strName, 2, True) '不存在则创建,强制覆盖
- oFile.Writeline str
- oFile.Close
- Set oFile = Nothing
- Set oFSO = Nothing
- End Sub
- reReplace(str ,"^" & vbcrlf,"")
- Function reReplace(str,patrn, replStr)
- Dim regEx, str1
- Set regEx = New RegExp
- regEx.Pattern = patrn
- regEx.IgnoreCase = True
- regEx.Global = false
- reReplace = regEx.Replace(str, replStr)
- End Function
复制代码
作者: newswan 时间: 2021-6-5 12:56
本帖最后由 newswan 于 2021-6-5 13:38 编辑
brr 从 0 开始- For a = 0 To UBound(arr, 1)
- brr(a) = arr(a, 1)
- For b = 2 To UBound(arr, 2)
- brr(a) = arr(a, b) & "," & brr(a)
- 'brr(a) = brr(a) & "," & arr(a, b)
- Next
- 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 编辑
全部还原复制代码
然后 删除 str 前2个字符
作者: newswan 时间: 2021-6-5 15:14
本帖最后由 newswan 于 2021-6-5 15:35 编辑
- dim arr
-
- redim arr(5)
- for i= 0 to 5
- arr(i)=i
- next
- Write "v2.txt" , join(arr,vbCrLf)
-
- Sub Write(strName,str)
- Dim oFSO, oFile
- Set oFSO = CreateObject("Scripting.FileSystemObject")
- Set oFile = oFSO.OpenTextFile(strName, 2, True)
- oFile.Writeline str
- oFile.Close
- Set oFile = Nothing
- Set oFSO = Nothing
- End Sub
复制代码
用这个测试,writeline str 后面不需要加 vbcrlf
如果brr(0) 没有值,那么前面会多一个空行
去掉开始的空行- reReplace(str ,"^" & vbcrlf,"")
- Function reReplace(str,patrn, replStr)
- Dim regEx, str1
- Set regEx = New RegExp
- regEx.Pattern = patrn
- regEx.IgnoreCase = True
- regEx.Global = false
- reReplace = regEx.Replace(str, replStr)
- End Function
复制代码
作者: superman 时间: 2021-6-5 16:42
回复 7# newswan
我运行还是要报错,不知为啥
论坛传不了附件,附上测试数据
https://wwr.lanzoui.com/iIZWQptnkif
作者: newswan 时间: 2021-6-5 17:49
- Dim strPath
- Dim arr, arrLine, t
-
- If wscript.Arguments.Count = 0 Then
- MsgBox "拖拽Excel文件到本vbs文件", 0, "提示"
- End If
- For jb = 0 To wscript.Arguments.Count - 1
- strPath = wscript.Arguments(jb)
- MsgBox "将要导出" & strPath, vbOKCancel, "提示"
- Next
-
- Set oExcel = CreateObject("Excel.Application")
- Set oWorkBook = oExcel.Workbooks.Open("C:\Users\admin\Desktop\test\d.xlsx")
- Set oSheet = oWorkBook.Sheets(1)
- arr = oSheet.UsedRange.Range("B1:C" & oSheet.UsedRange.Rows.Count)
- Set oSheet = Nothing
- oWorkBook.Close False
- Set oWorkBook = Nothing
- oExcel.Quit
-
- ReDim arrLine(UBound(arr, 1)-1)
- For a = 1 To UBound(arr, 1)
- arrLine(a-1) = arr(a, 2) & "," & arr(a,1)
- Next
-
- str = Join(arrLine, vbCrLf)
- Write strpath & ".txt" , Join(arrLine, vbCrLf)
-
-
- Sub Write(strName,str)
- Dim oFSO, oFile
- Set oFSO = CreateObject("Scripting.FileSystemObject")
- Set oFile = oFSO.OpenTextFile(strName, 2, True) '不存在则创建,强制覆盖
-
- oFile.Writeline str
-
- oFile.Close
-
- Set oFile = Nothing
- Set oFSO = Nothing
-
- End Sub
复制代码
欢迎光临 批处理之家 (http://bathome.net./) |
Powered by Discuz! 7.2 |