VBScript循环遍历文件夹中的所有文件

时间:2013-05-21 08:48:43

标签: csv batch-file vbscript

我有代码在单个文件上执行该过程,任何人都可以更改此脚本,以便循环遍历目录“H:\ Letter Display \ Letters”中文件类型为“ .LTR”的所有文件“并将它们全部保存:

 Const ForReading = 1
 Const ForWriting = 2

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objFile = objFSO.OpenTextFile("H:\Letter Display\Letters\LTRPRT__00000008720000000001NI-K-RMND.LTR",    ForReading)


 str1000 = "1000"
 str1100 = "1100"
 str1200 = "1200"
 str9990 = "9990"

 arrCommas1 = Array(14,31,41,59,70,81,101,111,124,138)
 arrCommas2 = Array(14,31,41,55,79,144,209,274,409,563,589,608,623)
 arrCommas3 = ArraY  (14,32,41,73,83,97,106,156,167,184,188,195,207,260,273,332,368,431,461,472,593,617,666,772,810,834,848,894,898)
 arrCommas4 = Array(14,31,41)

 Do Until objFile.AtEndOfStream
   strLine = objFile.ReadLine

   If Left(strLine, 4) = str1000 then
     intLength = Len(strLine)
     For Each strComma in arrCommas1
       strLine = Left(strLine, strComma - 1) + "," _
         + Mid(strLine, strComma, intLength)
     Next
   End If

   If Left(strLine, 4) = str1100 then
     intLength = Len(strLine)
     For Each strComma in arrCommas2
       strLine = Left(strLine, strComma - 1) + "," _
         + Mid(strLine, strComma, intLength)
     Next
   End If

  If Left(strLine, 4) = str1200 then
     intLength = Len(strLine)
     For Each strComma in arrCommas3
       strLine = Left(strLine, strComma - 1) + "," _
         + Mid(strLine, strComma, intLength)
     Next
   End If

  If Left(strLine, 4) = str9990 then
     intLength = Len(strLine)
     For Each strComma in arrCommas4
       strLine = Left(strLine, strComma - 1) + "," _
         + Mid(strLine, strComma, intLength)
     Next
   End If

   strText = strText & strLine & vbCrLf
 Loop


 objFile.Close

 Set objFile = objFSO.OpenTextFile("H:\Letter Display\Letters\LTRPRT__00000008720000000001NI-K-RMND.LTR",  ForWriting)
 objFile.Write strText
 objFile.Close

非常感谢任何帮助!

由于

4 个答案:

答案 0 :(得分:13)

也许这会让事情变得清晰起来。 (或者让你更加困惑,)

Const ForReading = 1
Const ForWriting = 2

sFolder = "H:\Letter Display\Letters\"
Set oFSO = CreateObject("Scripting.FileSystemObject")

For Each oFile In oFSO.GetFolder(sFolder).Files
  If UCase(oFSO.GetExtensionName(oFile.Name)) = "LTR" Then
    ProcessFiles oFSO, oFile
  End if
Next

Set oFSO = Nothing


Sub ProcessFiles(FSO, File)

Set oFile2 = FSO.OpenTextFile(File.path, ForReading)

 str1000 = "1000"
 str1100 = "1100"
 str1200 = "1200"
 str9990 = "9990"

 arrCommas1 = Array(14,31,41,59,70,81,101,111,124,138)
 arrCommas2 = Array(14,31,41,55,79,144,209,274,409,563,589,608,623)
 arrCommas3 = ArraY  (14,32,41,73,83,97,106,156,167,184,188,195,207,260,273,332,368,431,461,472,593,617,666,772,810,834,848,894,898)
 arrCommas4 = Array(14,31,41)

     Do Until oFile2.AtEndOfStream
       strLine = oFile2.ReadLine

       If Left(strLine, 4) = str1000 then
         intLength = Len(strLine)
         For Each strComma in arrCommas1
           strLine = Left(strLine, strComma - 1) + "," _
             + Mid(strLine, strComma, intLength)
         Next
       End If

       If Left(strLine, 4) = str1100 then
         intLength = Len(strLine)
         For Each strComma in arrCommas2
           strLine = Left(strLine, strComma - 1) + "," _
             + Mid(strLine, strComma, intLength)
         Next
       End If

      If Left(strLine, 4) = str1200 then
         intLength = Len(strLine)
         For Each strComma in arrCommas3
           strLine = Left(strLine, strComma - 1) + "," _
             + Mid(strLine, strComma, intLength)
         Next
       End If

      If Left(strLine, 4) = str9990 then
         intLength = Len(strLine)
         For Each strComma in arrCommas4
           strLine = Left(strLine, strComma - 1) + "," _
             + Mid(strLine, strComma, intLength)
         Next
       End If

       strText = strText & strLine & vbCrLf
     Loop

     sFile = File.path
     oFile2.close
     set oFile2 = Nothing

     Set File = FSO.OpenTextFile(sFile ,  ForWriting)
     File.Write strText
     File.Close
     Set File = Nothing

 end sub

答案 1 :(得分:3)

您当前的脚本基本上执行以下操作:

Set objFile = objFSO.OpenTextFile("...", ForReading)
Do Until objFile.AtEndOfStream
  strLine = objFile.ReadLine
  'do stuff with strLine and append to strText
Loop
objFile.Close

Set objFile = objFSO.OpenTextFile("...", ForWriting)
objFile.Write strText
objFile.Close

为了处理给定文件夹中的所有文件,您只需要在其周围添加一个外部循环,并相应地调整一些指令:

For Each f In objFSO.GetFolder("C:\some\folder").Files
  Set objFile = f.OpenAsTextStream
  Do Until objFile.AtEndOfStream
    strLine = objFile.ReadLine
    'do stuff with strLine and append to strText
  Loop
  objFile.Close

  Set objFile = f.OpenAsTextStream(ForWriting)
  objFile.Write strText
  objFile.Close
Next

答案 2 :(得分:0)

更好的是做一个递归函数进入主文件夹下面的所有文件夹并搜索那些..只是想法:)

答案 3 :(得分:0)

这不能解决您的确切情况,因为如果您只需要执行简单的字符串替换操作,就不会看到文件,我不确定所有这些数组和逻辑的用途,但是下面的代码会将文件放在一个给定目录,用几个示例字符串替换对其进行编辑,然后保存它们。您将以下内容另存为H:\Letter Display\FixLTRFiles.vbs并运行它:

Option Explicit

Dim FSO, FLD, FIL, TS
Dim strFolder, strContent, strPath
Const ForReading = 1, ForWriting = 2, ForAppending = 8 

'Change as needed - this names a folder at the same location as this script
strFolder = "Letters"

'Create the filesystem object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get a reference to the folder you want to search
set FLD = FSO.GetFolder(strFolder)

'loop through the folder and get the file names
For Each Fil In FLD.Files
    'MsgBox Fil.Name
    If UCase(FSO.GetExtensionName(Fil.Name)) = "LTR" Then

        'Open the file to read
        Set TS = FSO.OpenTextFile(Fil.Path, ForReading)
        'Read the contents into a variable
        strContent = TS.ReadAll
        'Close the file
        TS.Close

        'Replace the errant strings
        IF INSTR(strContent,"SomeContentToReplace")>0 THEN
             strContent = Replace(strContent, "SomeContentToReplace", "MyNewContent")
        END IF
        IF INSTR(strContent,"MoreContentToReplace")>0 THEN
            strContent = Replace(strContent, "MoreContentToReplace", "MyOtherNewContent")
        END IF

        'Open the file to overwrite the contents
        Set TS = FSO.OpenTextFile(Fil.Path, ForWriting)
        'Write the contents back
        TS.Write strContent
        'Close the current file
        TS.Close

    End If
Next


'Clean up
Set TS = Nothing
Set FLD = Nothing
Set FSO = Nothing

MsgBox "Done!"