[问题求助] VBS脚本如何把文本中两个指定字符串之间的内容另存为新的文本文件？

ss1268

vbs如何把2个字符串("%",包含字符串的内容)之间的内容分割为新的文本文件。

最好不要借助第三方工具，谢谢

如以下文本中有很多个”%“，而且都是偶数个。如何把2个”%“之间的内容（包含2个”%“）分割为一个新的文本文件，谢谢.
%
X1.6427Y-.1277Z.3317
X1.5239Y.0362Z.3398
X1.4176Y.2086Z.3477
%
%
X1.6427Y-.1277Z.3317
X1.5239Y.0362Z.3398
X1.4176Y.2086Z.3477
X1.328Y.3813Z.3552
X1.2674Y.5177Z.3608
X1.199Y.7014Z.368
X1.1422Y.8978Z.3752
X1.1004Y1.0978Z.3821
X1.0738Y1.3004Z.3886
X1.0627Y1.5044Z.3947
X1.0671Y1.7086Z.4004
X1.0868Y1.9118Z.4056
X1.1218Y2.1129Z.4103
X1.1718Y2.3106Z.4145
X1.2364Y2.5039Z.4181
X1.3151Y2.6917Z.4212
X1.4075Y2.8729Z.4237
%
%
X1.328Y.3813Z.3552
X1.2674Y.5177Z.3608
X1.199Y.7014Z.368
X1.1422Y.8978Z.3752
X1.1004Y1.0978Z.3821
X1.0738Y1.3004Z.3886
X1.0627Y1.5044Z.3947
X1.0671Y1.7086Z.4004
X1.0868Y1.9118Z.4056
%
%
X1.2674Y.5177Z.3608
X1.199Y.7014Z.368
X1.1422Y.8978Z.3752
X1.1004Y1.0978Z.3821
X1.0738Y1.3004Z.3886
X1.0627Y1.5044Z.3947
X1.0671Y1.7086Z.4004
X1.0868Y1.9118Z.4056
X1.1218Y2.1129Z.4103
X1.1718Y2.3106Z.4145
X1.2364Y2.5039Z.4181
X1.3151Y2.6917Z.4212
X1.4075Y2.8729Z.4237
%
%
X1.1218Y2.1129Z.4103
X1.1718Y2.3106Z.4145
X1.2364Y2.5039Z.4181
X1.3151Y2.6917Z.4212
X1.4075Y2.8729Z.4237
%

Demon

'Author: Demon
'Website: http://demon.tw
'Date: 2012/2/6
Set fso = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Global = True
re.Pattern = "%([^%]+)%"
str = fso.OpenTextFile("data.txt").ReadAll
Set ms = re.Execute(str)
For i = 0 To ms.Count - 1
    fso.OpenTextFile(i & ".txt", 2, True).Write ms.Item(i).Submatches(0)
Next

ss1268

回复 2# Demon


    谢谢老师的解答，基本是这种效果。
还有一个疑问，请问如何在头尾都把%带上，谢谢！

同时一下脚本出错，不知哪里有问题，还亲老师帮忙看看，

' -- Start Script
Call Main()
'////////////////////
' Sub Declaration
' ////////////////////
Sub Main()
Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")
Str = fso.OpenTextFile("data.text").ReadAll

ShowString(RegExpTest("%([^%]+)%", Str))

Set fso = Nothing
End Sub

Function RegExpTest(patrn, Str)
   Dim regEx, Match, Matches, RetStr, i   ' Create variable.
   Set regEx = New RegExp 
   regEx.Pattern = patrn
   regEx.IgnoreCase = True 
   regEx.Global = True 
   Set Matches = regEx.Execute(Str)
	For i = 0 To Matches.Count - 1
	fso.OpenTextFile(i & ".nc", 2, True).Write Matches.Item(i).Submatches(0)
	Next	
   RegExpTest = RetStr
End Function
复制代码

samsinn

重新再输入好了

Set fs = CreateObject("Scripting.FileSystemObject")
szBuf = InputBox( "请输入文本路径：", "输入", "c:\data.txt" )
LINK = Trim(szBuf)
If fs.FileExists(LINK) Then
	Set File_Open = Fs.OpenTextFile(LINK,1) 
	Set File_Open2 = Fs.OpenTextFile("c:\newdata.txt",2,true) 
	Line=File_Open.Readall
	Line="%"&line&"%"     '文本的头尾加上符号%
	File_Open2.WriteLine Line
	File_Open2.Close
wsh.quit
Else
Wscript.echo "找不到文件!本程序将退出！"
Wscript.Quit
End If
复制代码

l
ms.Item(i).Submatches(0) 换成 "%"&ms.Item(i).Submatches(0)&"%"

ss1268

回复 5# samsinn


    能否给出完整的代码，谢谢！！！
我不懂vbs，因为我用其他方法实在是整不出来，才想到用vbs脚本完成，谢谢你的帮助！！！

samsinn

'Author: Demon
'Website: http://demon.tw
'Date: 2012/2/6

Set fso = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Global = True
re.Pattern = "%([^%]+)%"
str = fso.OpenTextFile("data.txt").ReadAll
Set ms = re.Execute(str)
For i = 0 To ms.Count - 1
    fso.OpenTextFile(i & ".txt", 2, True).Write "%"&ms.Item(i).Submatches(0)&"%"
Next
复制代码

第8行代码改一下就好啦

ss1268

回复 7# samsinn


    谢谢你。已经解决了