批处理之家 - Powered by Discuz! Board

标题: [问题求助] 求助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 = Join(brr, vbCrLf)
复制代码

然后删除 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://www.bathome.net/)

Powered by Discuz! 7.2