[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

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

下述代码运行后,会产生一个new文件夹,new 文件夹内还会产生若干子文件夹,如何修改代码,去除代码运行后产生的new文件夹及其内的子文件夹?恳望得到大家的帮助!
  1. Set FSO = CreateObject("Scripting.FileSystemObject")
  2. If Not FSO.FolderExists("New") Then FSO.CreateFolder("New")
  3. For Each File in FSO.GetFolder(".").Files
  4.    Ext = FSO.GetExtensionName(File)
  5.    Name = FSO.GetBaseName(File)
  6.    If LCase(Ext) = "txt" Then
  7.       fDir = "New\" & Name
  8.       If Not FSO.FolderExists(fDir) Then FSO.CreateFolder(fDir)
  9.       Open_File FSO.OpenTextFile(File)
  10.    End If
  11. Next
  12. Sub Open_File(f)
  13.    Do Until f.AtEndOfStream
  14.       Text = f.ReadLine
  15.       If RegEx(Text) <> "" Then GetStr Split(RegEx(Text)," ")
  16.    Loop
  17. End Sub
  18. Sub GetStr(ar)
  19.    Dim A(9)
  20.    For i = 0 to 9 :A(i) = 0 :Next
  21.    For i = 1 to UBound(ar) - 1
  22.       For j = i + 1 to UBound(ar)
  23.          s1 = Right(CInt(ar(i)) + CInt(ar(j)),1) :A(s1) = A(s1) + 1
  24.          s2 = Right(CInt(ar(i)) - CInt(ar(j)),1) :A(s2) = A(s2) + 1
  25.          s3 = Right(CInt(ar(i)) * CInt(ar(j)),1) :A(s3) = A(s3) + 1
  26.       Next
  27.    Next
  28.    For i = 1 to 6
  29.       For j = i + 1 to 7
  30.          For k = j + 1 to 8
  31.             For L = k + 1 to 9
  32.                ReDim PreServe B(n)
  33.                B(n) = A(i) + A(j) + A(k) + A(L) + A(0)
  34.                n = n + 1
  35.             Next
  36.          Next
  37.       Next
  38.    Next
  39.    n = 1
  40.    For i = 1 to UBound(B) + 1
  41.       Str = Str & " " & B(i-1)
  42.       If i Mod 126 = 0 Then
  43.          FSO.OpenTextFile(fDir&"\"&Name&"_"&n&".txt",8,True).WriteLine Str
  44.          Str = "" :n = n + 1
  45.       End If
  46.    Next
  47. End Sub
  48. Function RegEx(Text)
  49.    Set Re = New RegExp
  50.    Re.Pattern = "\s+"
  51.    Re.Global = True
  52.    RegEx = Trim(Re.Replace(Text," "))
  53. End Function
复制代码
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2

目前对vbs吐血级别......
活着就是为了改变世界

TOP

  1. Set FSO = CreateObject("Scripting.FileSystemObject")
  2. If Not FSO.FolderExists("New") Then FSO.CreateFolder("New")
  3. For Each File in FSO.GetFolder(".").Files
  4.    Ext = FSO.GetExtensionName(File)
  5.    Name = FSO.GetBaseName(File)
  6.    If LCase(Ext) = "txt" Then
  7.       fDir = "New\" & Name
  8.       If Not FSO.FolderExists(fDir) Then FSO.CreateFolder(fDir)
  9.       Open_File FSO.OpenTextFile(File)
  10.    End If
  11. Next
  12. FSO.DeleteFolder "New", True
  13. Sub Open_File(f)
  14.    Do Until f.AtEndOfStream
  15.       Text = f.ReadLine
  16.       If RegEx(Text) <> "" Then GetStr Split(RegEx(Text)," ")
  17.    Loop
  18. End Sub
  19. Sub GetStr(ar)
  20.    Dim A(9)
  21.    For i = 0 to 9 :A(i) = 0 :Next
  22.    For i = 1 to UBound(ar) - 1
  23.       For j = i + 1 to UBound(ar)
  24.          s1 = Right(CInt(ar(i)) + CInt(ar(j)),1) :A(s1) = A(s1) + 1
  25.          s2 = Right(CInt(ar(i)) - CInt(ar(j)),1) :A(s2) = A(s2) + 1
  26.          s3 = Right(CInt(ar(i)) * CInt(ar(j)),1) :A(s3) = A(s3) + 1
  27.       Next
  28.    Next
  29.    For i = 1 to 6
  30.       For j = i + 1 to 7
  31.          For k = j + 1 to 8
  32.             For L = k + 1 to 9
  33.                ReDim PreServe B(n)
  34.                B(n) = A(i) + A(j) + A(k) + A(L) + A(0)
  35.                n = n + 1
  36.             Next
  37.          Next
  38.       Next
  39.    Next
  40.    n = 1
  41.    For i = 1 to UBound(B) + 1
  42.       Str = Str & " " & B(i-1)
  43.       If i Mod 126 = 0 Then
  44.          FSO.OpenTextFile(fDir&"\"&Name&"_"&n&".txt",8,True).WriteLine Str
  45.          Str = "" :n = n + 1
  46.       End If
  47.    Next
  48. End Sub
  49. Function RegEx(Text)
  50.    Set Re = New RegExp
  51.    Re.Pattern = "\s+"
  52.    Re.Global = True
  53.    RegEx = Trim(Re.Replace(Text," "))
  54. End Function
复制代码
1

评分人数


QQ 20147578

TOP

回复 3# czjt1234


    谢谢您的热心帮助!

TOP

返回列表