批处理之家 - Powered by Discuz! Board

标题: [问题求助] 【已解决】怎样去除VBS代码运行后产生的new文件夹及其内的子文件夹？ [打印本页]

作者: 思想之翼 时间: 2013-4-7 09:55 标题: 【已解决】怎样去除VBS代码运行后产生的new文件夹及其内的子文件夹？

本帖最后由思想之翼于 2013-4-15 01:03 编辑

下述代码运行后，会产生一个new文件夹，new 文件夹内还会产生若干子文件夹，如何修改代码，去除代码运行后产生的new文件夹及其内的子文件夹？恳望得到大家的帮助！

Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists("New") Then FSO.CreateFolder("New")
For Each File in FSO.GetFolder(".").Files
   Ext = FSO.GetExtensionName(File)
   Name = FSO.GetBaseName(File)
   If LCase(Ext) = "txt" Then
      fDir = "New\" & Name
      If Not FSO.FolderExists(fDir) Then FSO.CreateFolder(fDir)
      Open_File FSO.OpenTextFile(File)
   End If
Next

Sub Open_File(f)
   Do Until f.AtEndOfStream
      Text = f.ReadLine
      If RegEx(Text) <> "" Then GetStr Split(RegEx(Text)," ")
   Loop
End Sub

Sub GetStr(ar)
   Dim A(9)
   For i = 0 to 9 :A(i) = 0 :Next
   For i = 1 to UBound(ar) - 1
      For j = i + 1 to UBound(ar)
         s1 = Right(CInt(ar(i)) + CInt(ar(j)),1) :A(s1) = A(s1) + 1
         s2 = Right(CInt(ar(i)) - CInt(ar(j)),1) :A(s2) = A(s2) + 1
         s3 = Right(CInt(ar(i)) * CInt(ar(j)),1) :A(s3) = A(s3) + 1
      Next
   Next

   For i = 1 to 6
      For j = i + 1 to 7
         For k = j + 1 to 8
            For L = k + 1 to 9
               ReDim PreServe B(n)
               B(n) = A(i) + A(j) + A(k) + A(L) + A(0)
               n = n + 1
            Next
         Next
      Next
   Next

   n = 1
   For i = 1 to UBound(B) + 1
      Str = Str & " " & B(i-1)
      If i Mod 126 = 0 Then
         FSO.OpenTextFile(fDir&"\"&Name&"_"&n&".txt",8,True).WriteLine Str
         Str = "" :n = n + 1
      End If
   Next
End Sub

Function RegEx(Text)
   Set Re = New RegExp
   Re.Pattern = "\s+"
   Re.Global = True
   RegEx = Trim(Re.Replace(Text," "))
End Function
复制代码

作者: 林小七 时间: 2013-4-7 10:07

目前对vbs吐血级别......

作者: czjt1234 时间: 2013-4-8 19:23

Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists("New") Then FSO.CreateFolder("New")
For Each File in FSO.GetFolder(".").Files
   Ext = FSO.GetExtensionName(File)
   Name = FSO.GetBaseName(File)
   If LCase(Ext) = "txt" Then
      fDir = "New\" & Name
      If Not FSO.FolderExists(fDir) Then FSO.CreateFolder(fDir)
      Open_File FSO.OpenTextFile(File)
   End If
Next

FSO.DeleteFolder "New", True

Sub Open_File(f)
   Do Until f.AtEndOfStream
      Text = f.ReadLine
      If RegEx(Text) <> "" Then GetStr Split(RegEx(Text)," ")
   Loop
End Sub

Sub GetStr(ar)
   Dim A(9)
   For i = 0 to 9 :A(i) = 0 :Next
   For i = 1 to UBound(ar) - 1
      For j = i + 1 to UBound(ar)
         s1 = Right(CInt(ar(i)) + CInt(ar(j)),1) :A(s1) = A(s1) + 1
         s2 = Right(CInt(ar(i)) - CInt(ar(j)),1) :A(s2) = A(s2) + 1
         s3 = Right(CInt(ar(i)) * CInt(ar(j)),1) :A(s3) = A(s3) + 1
      Next
   Next

   For i = 1 to 6
      For j = i + 1 to 7
         For k = j + 1 to 8
            For L = k + 1 to 9
               ReDim PreServe B(n)
               B(n) = A(i) + A(j) + A(k) + A(L) + A(0)
               n = n + 1
            Next
         Next
      Next
   Next

   n = 1
   For i = 1 to UBound(B) + 1
      Str = Str & " " & B(i-1)
      If i Mod 126 = 0 Then
         FSO.OpenTextFile(fDir&"\"&Name&"_"&n&".txt",8,True).WriteLine Str
         Str = "" :n = n + 1
      End If
   Next
End Sub

Function RegEx(Text)
   Set Re = New RegExp
   Re.Pattern = "\s+"
   Re.Global = True
   RegEx = Trim(Re.Replace(Text," "))
End Function
复制代码

作者: 思想之翼 时间: 2013-4-9 16:33

回复 3# czjt1234

谢谢您的热心帮助！

欢迎光临批处理之家 (http://bbs.bathome.net/)

Powered by Discuz! 7.2