how can I create shortcut for all files in a folder with BAT file?
I have the code to carry out the process on a single file, could anyone alter this script so it loops through all files in the directory "H:\Letter Display\Letters" with the file type ".LTR" and saves them all:
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
Any help would be much appreciated!
Thanks
Maybe this will clear things up. (Or confuse you more, )
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
Your current script basically does the following:
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 processing all files in a given folder you just need to add an outer loop around that, and adjust some instructions accordingly:
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
What would be even better is to do a recursive function to go into all folders that are below your main folder and search those as well.. Just and idea :)
This doesn't address your exact scenario because without seeing the files I'm not sure what all those arrays and logic are for if you just need to do simple string replacements, but code I have below would take the files in a given directory, edit them with a couple of example string replacements, and then save them. You would save the following as H:\Letter Display\FixLTRFiles.vbs
and run it:
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!"