sbubendorf
09-19-2007, 08:05 AM
I have some code that I've pieced together that works as I intended when a single file is dropped on the VBS script icon. It does not work properly for multiple files dropped on the icon. Might someone be able to help me revise the code to work for multiple files? I'm very much a beginner, so I'm sure there is much in the code that could have been done differently and better, but here is what I currently have:
Dim objArgs
Dim strFile, strFile2, strFile3, strFile4
Dim objFSO
Dim sText, sFound, sTextadd, sText9, sText11, sTexty
Dim sTexty0, sTexty1, sTexty2, sTexty3, RsTexty1
Dim NewTextLine, NArray
Dim arr, x, y
Dim objFile
Dim strFileBase, strFileExt
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
On Error Resume Next
Set objArgs = WScript.Arguments
For i = 0 To objArgs.Count - 1
strFile = objArgs(i)
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFileBase = objFso.GetBaseName (strFile)
strFileExt = objFso.GetExtensionName (strFile)
strFile2 = objFso.GetParentFolderName(strFile)
strTmpFile = strFile2 & "\TmpStart.txt"
strTmpFile2 = strFile2 & "\TmpEnd.txt"
strTmpFile3 = strFile2 & "\Reversed.txt"
strFile3 = strFile2 & "\BACKUP"
CreateFullPath strFile3
CopyFile strFile, strFile3
strFile4 = strFile2 & "\CHANNELS"
CreateFullPath strFile4
If objFSO.FileExists (strTmpFile) Then objFSO.DeleteFile (strTmpFile)'TmpStart.txt
If objFSO.FileExists (strTmpFile2) Then objFSO.DeleteFile (strTmpFile2)'TmpEnd.txt
If objFSO.FileExists (strTmpFile3) Then objFSO.DeleteFile (strTmpFile3)'Reversed.txt
Set objFile = objFSO.CreateTextFile (strTmpFile2,ForReading)'TmpEnd.txt
objFile.Close
Set objFile = objFSO.CreateTextFile (strTmpFile3,ForReading)'Reversed.txt
objFile.Close
Set objFile = objFSO.OpenTextFile (strFile, ForReading)'Original nc1 file
sText = objFile.ReadAll
objFile.Close
arr = Split(sText,vbCrLf)
sText9 = arr (8)
sText11 = arr (10)
If Instr(1, sText9,"C",vbTextCompare) Then 'IF#1
For y = 1 To UBound(arr)
sTextadd = Trim(sTextadd & vbCrLf & arr(y))
If Instr(1,(arr (y)),"BO",vbTextCompare) Then'IF#2
Do Until InStr (1, arr (y + 1), "EN", vbTextCompare)<> 0
sTexty = arr (y + 1)
sTexty = Trim (sTexty)
Do While InStr (1, sTexty, " ")
sTexty = Replace (sTexty, " ", " ")
Loop
arr2 = Split (sTexty," ",-1)
sTexty0 = arr2 (0)
sTexty1 = arr2 (1)
sTexty2 = arr2 (2)
sTexty3 = arr2 (3)
sTexty1 = Left (sTexty1, Len (sTexty1) - 1)
RsTexty1 = sText11 - sTexty1
NArray = Array (sTexty0, RsTexty1 & "o", sTexty2, sTexty3)
NewTextLine = Join (NArray, " ")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile (strTmpFile2,ForAppending)'TmpEnd.txt
objFile.Write NewTextLine & vbCrLf
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
y = y + 1
Loop
READUP
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile (strTmpFile,ForWriting)'TmpStart.txt
objFile.Write "ST" & sTextadd
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
CombineFiles
End If''''''''#2
Next'For y = 1 To UBound(arr)
End If'If #1
Next
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
sub CreateFullPath (byval path)
dim parent
path = objfso.GetAbsolutePathname(path)
parent = objfso.GetParentFolderName(path)
if not objfso.FolderExists(parent) then
CreateFullPath parent
end if
if not objfso.FolderExists(path) then
objfso.CreateFolder(path)
end if
end sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub CopyFile(FileSpec, NewFolder)
On Error Resume Next
If Right(NewFolder,1) <> "\" Then NewFolder = NewFolder & "\"
CheckForFile = objFSO.FileExists(FileSpec)
CheckForFolder = objFSO.FolderExists(NewFolder)
If CheckForFolder = TRUE Then
If CheckForFile = TRUE Then
FileName = objFSO.GetFileName(FileSpec)
NewFileName = NewFolder & FileName
If objFSO.FileExists(NewFileName) = TRUE Then
ClearAttributes NewFileName
End If
End If
objFSO.CopyFile FileSpec, NewFolder, TRUE
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub ClearAttributes(FileName)
On Error Resume Next
CheckforFile = objFSO.FileExists(FileName)
If CheckforFile = TRUE Then
Set objf = objFSO.GetFile(FileName)
'Clear hidden, system, or read-only attributes if necessary
If objf.attributes and 1 Then objf.attributes = objf.attributes - 1
If objf.attributes and 2 Then objf.attributes = objf.attributes - 2
If objf.attributes and 4 Then objf.attributes = objf.attributes - 4
Set objf = Nothing
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub ReadUP
Dim arrFileLines()
ind = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strTmpFile2, ForReading)'TmpEnd.txt
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(ind)
arrFileLines(ind) = objFile.ReadLine
ind = ind + 1
Loop
objFile.Close
For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1
Set objFile2 = objFSO.OpenTextFile (strTmpFile3, ForAppending)'Reversed.txt
objFile2.Write arrFileLines (l) & vbCrLf
objFile2.Close
Next
Set objFile2 = objFSO.OpenTextFile (strTmpFile3,ForAppending)'Reversed.txt
objFile2.Write "EN"
objFile2.Close
Set objFile = Nothing
Set objFile2 = Nothing
Set objFSO = Nothing
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub CombineFiles
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile (strFile4 & "\" & strFileBase & "." & strFileExt)'New nc1 file
Set objTextFile = objFSO.OpenTextFile(strTmpFile, ForReading)'TmpStart.txt
strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText
Set objTextFile = objFSO.OpenTextFile(strTmpFile3, ForReading)'Reversed.txt
strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText
objOutputFile.Close
End Sub
I don't see anywhere in the forum to attach files. If someone could let me know how to go about posting a couple of files to run as arguments to the VBScript, I would be happy to do so, if that would help.
Thank you very much for any help that can be provided.
Dim objArgs
Dim strFile, strFile2, strFile3, strFile4
Dim objFSO
Dim sText, sFound, sTextadd, sText9, sText11, sTexty
Dim sTexty0, sTexty1, sTexty2, sTexty3, RsTexty1
Dim NewTextLine, NArray
Dim arr, x, y
Dim objFile
Dim strFileBase, strFileExt
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
On Error Resume Next
Set objArgs = WScript.Arguments
For i = 0 To objArgs.Count - 1
strFile = objArgs(i)
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFileBase = objFso.GetBaseName (strFile)
strFileExt = objFso.GetExtensionName (strFile)
strFile2 = objFso.GetParentFolderName(strFile)
strTmpFile = strFile2 & "\TmpStart.txt"
strTmpFile2 = strFile2 & "\TmpEnd.txt"
strTmpFile3 = strFile2 & "\Reversed.txt"
strFile3 = strFile2 & "\BACKUP"
CreateFullPath strFile3
CopyFile strFile, strFile3
strFile4 = strFile2 & "\CHANNELS"
CreateFullPath strFile4
If objFSO.FileExists (strTmpFile) Then objFSO.DeleteFile (strTmpFile)'TmpStart.txt
If objFSO.FileExists (strTmpFile2) Then objFSO.DeleteFile (strTmpFile2)'TmpEnd.txt
If objFSO.FileExists (strTmpFile3) Then objFSO.DeleteFile (strTmpFile3)'Reversed.txt
Set objFile = objFSO.CreateTextFile (strTmpFile2,ForReading)'TmpEnd.txt
objFile.Close
Set objFile = objFSO.CreateTextFile (strTmpFile3,ForReading)'Reversed.txt
objFile.Close
Set objFile = objFSO.OpenTextFile (strFile, ForReading)'Original nc1 file
sText = objFile.ReadAll
objFile.Close
arr = Split(sText,vbCrLf)
sText9 = arr (8)
sText11 = arr (10)
If Instr(1, sText9,"C",vbTextCompare) Then 'IF#1
For y = 1 To UBound(arr)
sTextadd = Trim(sTextadd & vbCrLf & arr(y))
If Instr(1,(arr (y)),"BO",vbTextCompare) Then'IF#2
Do Until InStr (1, arr (y + 1), "EN", vbTextCompare)<> 0
sTexty = arr (y + 1)
sTexty = Trim (sTexty)
Do While InStr (1, sTexty, " ")
sTexty = Replace (sTexty, " ", " ")
Loop
arr2 = Split (sTexty," ",-1)
sTexty0 = arr2 (0)
sTexty1 = arr2 (1)
sTexty2 = arr2 (2)
sTexty3 = arr2 (3)
sTexty1 = Left (sTexty1, Len (sTexty1) - 1)
RsTexty1 = sText11 - sTexty1
NArray = Array (sTexty0, RsTexty1 & "o", sTexty2, sTexty3)
NewTextLine = Join (NArray, " ")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile (strTmpFile2,ForAppending)'TmpEnd.txt
objFile.Write NewTextLine & vbCrLf
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
y = y + 1
Loop
READUP
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile (strTmpFile,ForWriting)'TmpStart.txt
objFile.Write "ST" & sTextadd
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
CombineFiles
End If''''''''#2
Next'For y = 1 To UBound(arr)
End If'If #1
Next
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
sub CreateFullPath (byval path)
dim parent
path = objfso.GetAbsolutePathname(path)
parent = objfso.GetParentFolderName(path)
if not objfso.FolderExists(parent) then
CreateFullPath parent
end if
if not objfso.FolderExists(path) then
objfso.CreateFolder(path)
end if
end sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub CopyFile(FileSpec, NewFolder)
On Error Resume Next
If Right(NewFolder,1) <> "\" Then NewFolder = NewFolder & "\"
CheckForFile = objFSO.FileExists(FileSpec)
CheckForFolder = objFSO.FolderExists(NewFolder)
If CheckForFolder = TRUE Then
If CheckForFile = TRUE Then
FileName = objFSO.GetFileName(FileSpec)
NewFileName = NewFolder & FileName
If objFSO.FileExists(NewFileName) = TRUE Then
ClearAttributes NewFileName
End If
End If
objFSO.CopyFile FileSpec, NewFolder, TRUE
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub ClearAttributes(FileName)
On Error Resume Next
CheckforFile = objFSO.FileExists(FileName)
If CheckforFile = TRUE Then
Set objf = objFSO.GetFile(FileName)
'Clear hidden, system, or read-only attributes if necessary
If objf.attributes and 1 Then objf.attributes = objf.attributes - 1
If objf.attributes and 2 Then objf.attributes = objf.attributes - 2
If objf.attributes and 4 Then objf.attributes = objf.attributes - 4
Set objf = Nothing
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub ReadUP
Dim arrFileLines()
ind = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strTmpFile2, ForReading)'TmpEnd.txt
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(ind)
arrFileLines(ind) = objFile.ReadLine
ind = ind + 1
Loop
objFile.Close
For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1
Set objFile2 = objFSO.OpenTextFile (strTmpFile3, ForAppending)'Reversed.txt
objFile2.Write arrFileLines (l) & vbCrLf
objFile2.Close
Next
Set objFile2 = objFSO.OpenTextFile (strTmpFile3,ForAppending)'Reversed.txt
objFile2.Write "EN"
objFile2.Close
Set objFile = Nothing
Set objFile2 = Nothing
Set objFSO = Nothing
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
Sub CombineFiles
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile (strFile4 & "\" & strFileBase & "." & strFileExt)'New nc1 file
Set objTextFile = objFSO.OpenTextFile(strTmpFile, ForReading)'TmpStart.txt
strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText
Set objTextFile = objFSO.OpenTextFile(strTmpFile3, ForReading)'Reversed.txt
strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText
objOutputFile.Close
End Sub
I don't see anywhere in the forum to attach files. If someone could let me know how to go about posting a couple of files to run as arguments to the VBScript, I would be happy to do so, if that would help.
Thank you very much for any help that can be provided.