我有代码在单个文件上执行该过程,任何人都可以更改此脚本,以便循环遍历目录“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
非常感谢任何帮助!
由于
答案 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!"