tim44202
asked on
VB Script problem
I have a script that reformats a text file by replacing some strings and dropping some lines. It seems to be functioning satisfactorily. The script presently operates on a predefined file name in a specific folder and writes the new file as a predefined name in a different folder. To use it as it stands there is a lot of copying of files and renaming them so the script can operate on them.
I want to have the script iterate through all files in a specific folder and copy them to another folder retaining the same name.
Here is the portion of the script that does the copying.
''''********************** ********** ********** ********** ********** ********** ********** ********** **
'Here's the code that does the copying
'
'Here is the string replacement Logic
'
'************************* ********** ********** ********** ********** ********** *
Do while not fle1.AtEndofStream
strLinePrior = strLine
strLine = fle1.ReadLine
strLine = Replace(strLine,"*U*00401* ","*U*0050 1*")
strLine = Replace(strLine,"*X*004010 X098A1","* X*005010X2 22A1")
strLine = Replace(strLine,"ST*837*00 01","ST*83 7*0001*005 010222")
strLine = Replace(strLine,"34-071444 1","340714 441")
strLine = Replace(strLine,"OH*44122" ,"OH*44122 5715")
' Place of Service Qualifier Added
strLine = Replace(strLine,"11::1*Y*A *Y*A*C","1 1:B:1*Y*A* Y*I*P")
strLine = Replace(strLine,"12::1*Y*A *Y*A*C","5 3:B:1*Y*A* Y*I*P")
strLine = Replace(strLine,"53::1*Y*A *Y*A*C","5 3:B:1*Y*A* Y*I*P")
' Drop Insurance Type
strLine = Replace(strLine,"*MB****ZZ ","*****ZZ ")
strLine = Replace(strLine,"*MC****ZZ ","*****ZZ ")
strLine = Replace(strLine,"OI***Y*C* *A","OI*** Y*P**I")
strLine = Replace(strLine,"REF*IG*S" ,"REF*SY*S ")
'========================= ========== ========== ========== ========== ========== ========== ========== ========== ========== ====
'Here's the code that drops the REF AND DTM segments
'and decrements the segment counter by 1
if Left(strLine, 6) <> "REF*87" AND left(strLinePrior,3) <> "AMT" AND left(strLine,3) <> "SE*" Then
fle2.WriteLine strLine
strLinePrior = strLine
Else
if left(strLine,3) = "SE*"Then
strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
fle2.WriteLine strLine
END If
END IF
''''********************** ********** ********** ********** ********** ********** ********** ********** **
I want to have the script iterate through all files in a specific folder and copy them to another folder retaining the same name.
Here is the portion of the script that does the copying.
''''**********************
'Here's the code that does the copying
'
'Here is the string replacement Logic
'
'*************************
Do while not fle1.AtEndofStream
strLinePrior = strLine
strLine = fle1.ReadLine
strLine = Replace(strLine,"*U*00401*
strLine = Replace(strLine,"*X*004010
strLine = Replace(strLine,"ST*837*00
strLine = Replace(strLine,"34-071444
strLine = Replace(strLine,"OH*44122"
' Place of Service Qualifier Added
strLine = Replace(strLine,"11::1*Y*A
strLine = Replace(strLine,"12::1*Y*A
strLine = Replace(strLine,"53::1*Y*A
' Drop Insurance Type
strLine = Replace(strLine,"*MB****ZZ
strLine = Replace(strLine,"*MC****ZZ
strLine = Replace(strLine,"OI***Y*C*
strLine = Replace(strLine,"REF*IG*S"
'=========================
'Here's the code that drops the REF AND DTM segments
'and decrements the segment counter by 1
if Left(strLine, 6) <> "REF*87" AND left(strLinePrior,3) <> "AMT" AND left(strLine,3) <> "SE*" Then
fle2.WriteLine strLine
strLinePrior = strLine
Else
if left(strLine,3) = "SE*"Then
strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
fle2.WriteLine strLine
END If
END IF
''''**********************
Can you use powershell for the copying?
ASKER
I am not really a programmer. I managed to get the existing script functioning by using sample scripts I found on the internet.
So the answer is I do not know if powershell would address the problem.
So the answer is I do not know if powershell would address the problem.
See if this works for you:
Option Explicit
Const ForReading = 1
Dim oFSO, oFile, oSourceStream, oDestinationStream, sSourceFolder, sDestinationFolder
Set oFSO = CreateObject("Scripting.FileSystemObject")
sSourceFolder = "c:\temp\dir1"
sDestinationFolder = "c:\temp\dir2"
for each oFile in oFSO.GetFolder(sSourceFolder).Files
Set oSourceStream = oFile.OpenAsTextStream(ForReading)
Set oDestinationStream = oFSO.CreateTextFile(sDestinationFolder + "\" + oFile.Name)
Do while not oSourceStream.AtEndofStream
'--- Place here your file processing logic ---'
Loop
oSourceStream.Close
oDestinationStream.Close
next
Here's an example of taking the source and destination folder names from the command line, and then doing a loop over all the files in the source folder (first parm) and calling a subroutine to do the processing of each file, passing the file object. You can add to the subroutine the logic you need to open, edit, copy, etc the file. If you want help with that post more of your existing code. Execute like this:
cscript yourname.vbs "c:\indir" "d:\outdir"
cscript yourname.vbs "c:\indir" "d:\outdir"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
If objArgs.Count > 0 Then
strBaseDir = oArgs(0)
If Right(strBaseDir, 1) <> "\" Then strBaseDir = strBaseDir & "\"
If Not objFSO.FolderExists(strBaseDir) Then
Wscript.Echo "Source folder does not exist."
Wscript.Quit
End If
Else
Wscript.Echo "No source folder to process specified."
Wscript.Quit
End If
If objArgs.Count > 1 Then
strDestDir = oArgs(1)
If Right(strDestDir, 1) <> "\" Then strDestDir = strDestDir & "\"
If Not objFSO.FolderExists(strDestDir) Then
Wscript.Echo "Destination folder does not exist."
Wscript.Quit
End If
Else
Wscript.Echo "No destination folder to process specified."
Wscript.Quit
End If
objBaseDir = objFSO.GetFolder(strBaseDir)
For Each objNextFile In objFolder.Files
ProcessFile(objNextFile)
Next
Wscript.Quit
Sub ProcessFile(objFile)
Wscript.Echo "Processing [" & objFile.Path & "]"
End Sub
~bp
ASKER
Here is complete code:
************************** ********** ********** *********
option explicit
on error resume next
dim objFSO 'as FileSystemObject
dim fle1 'as file
dim fle2 'as file
dim strPath 'as string
dim strFldr 'as string
dim strLine 'as string
dim strLinePrior 'as string
strPath = "C:\x12 Test Files\Infile.txt" 'Put in the file you want to edit
strFldr = "C:\x12 Test Files\OUT\out_file.txt"
' Initialize strLinePrior
strLinePrior = "First*Record"
Main 'This Calls the Main sub
sub Main()
dim rtn 'as integer
rtn = CopyStuff() 'This calls and runs the CopyStuff function
if rtn = 1 then
msgbox "Copy is complete"
else
msgbox "An error was found and the process was aborted. " & Cstr(rtn)
'The & Cstr(rtn) will display the number returned by CopyStuff
'After you've got your script running, you may want to remove this feature
end if
'Cleanup
if not fle1 is nothing then set fle1 = nothing
if not fle2 is nothing then set fle2 = nothing
if not objFSO is nothing then set objFSO = nothing
end Sub
' COPY FUNCTION
function CopyStuff()
set objFSO = CreateObject("Scripting.Fi leSystemOb ject") 'This creates the FSO
'I've included error handling after each step
if err.number <> 0 then
msgbox "Error in Creating Object: " & err.number & "; " & err.description
CopyStuff = 0 'Returns this number
exit function 'Stop processing, go back to Main
end if
if not objFSO.FileExists(strPath) then 'The file to copy is not present
msgbox "The " & strPath & " file was not found on this computer"
CopyStuff = 2
exit Function
' END FUNCTION
end if
if objFSO.FileExists(strFldr) then
objFSO.DeleteFile(strFldr) 'If the temp file is found, delete it
end if
set fle1 = objFSO.OpenTextFile(strPat h) 'Open
if err.number <> 0 then
msgbox "Error opening " & strPath & ": " & err.number & "; " & err.description
CopyStuff = 3
exit function
end if
set fle2 = objFSO.CreateTextFile(strF ldr) 'Create the temp file
if err.number <> 0 then
msgbox "Error creating temp ini: " & err.number & "; " & err.description
CopyStuff = 4
exit function
end If
'************************* ********** ********** ********** ********** ********** *
'Here's the code that does the copying
'
'Here is the string replacement Logic
'
'************************* ********** ********** ********** ********** ********** *
Do while not fle1.AtEndofStream
strLinePrior = strLine
strLine = fle1.ReadLine
strLine = Replace(strLine,"*U*00401* ","*U*0050 1*")
strLine = Replace(strLine,"*X*004010 X098A1","* X*005010X2 22A1")
strLine = Replace(strLine,"ST*837*00 01","ST*83 7*0001*005 010222")
strLine = Replace(strLine,"34-071444 1","340714 441")
strLine = Replace(strLine,"OH*44122" ,"OH*44122 5715")
' Place of Service Qualifier Added
strLine = Replace(strLine,"11::1*Y*A *Y*A*C","1 1:B:1*Y*A* Y*I*P")
strLine = Replace(strLine,"12::1*Y*A *Y*A*C","5 3:B:1*Y*A* Y*I*P")
strLine = Replace(strLine,"53::1*Y*A *Y*A*C","5 3:B:1*Y*A* Y*I*P")
' Drop Insurance Type
strLine = Replace(strLine,"*MB****ZZ ","*****ZZ ")
strLine = Replace(strLine,"*MC****ZZ ","*****ZZ ")
strLine = Replace(strLine,"OI***Y*C* *A","OI*** Y*P**I")
strLine = Replace(strLine,"REF*IG*S" ,"REF*SY*S ")
'========================= ========== ========== ========== ========== ========== ========== ========== ========== ========== ====
'Here's the code that drops the REF AND DTM segments
'and decrements the segment counter by 1
if Left(strLine, 6) <> "REF*87" AND left(strLinePrior,3) <> "AMT" AND left(strLine,3) <> "SE*" Then
fle2.WriteLine strLine
strLinePrior = strLine
Else
if left(strLine,3) = "SE*"Then
strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
fle2.WriteLine strLine
END If
END IF
'========================= ========== ========== ========== ========== ========== ========== ========== ========== ========== =====
loop
if err.number <> 0 then
msgbox "Error transfering data: " & err.number & "; " & err.description
CopyStuff = 5
fle1.close
fle2.close
exit function
end if
fle1.close
set fle1 = nothing
fle2.close
set fle2 = nothing
if err.number <> 0 then
msgbox "Error replacing " & strPath & " with new file: " & err.number & "; " & err.description
CopyStuff = 6
else
CopyStuff = 1 'Remember that in Main, a "1" means successful
end if
end function
**************************
option explicit
on error resume next
dim objFSO 'as FileSystemObject
dim fle1 'as file
dim fle2 'as file
dim strPath 'as string
dim strFldr 'as string
dim strLine 'as string
dim strLinePrior 'as string
strPath = "C:\x12 Test Files\Infile.txt" 'Put in the file you want to edit
strFldr = "C:\x12 Test Files\OUT\out_file.txt"
' Initialize strLinePrior
strLinePrior = "First*Record"
Main 'This Calls the Main sub
sub Main()
dim rtn 'as integer
rtn = CopyStuff() 'This calls and runs the CopyStuff function
if rtn = 1 then
msgbox "Copy is complete"
else
msgbox "An error was found and the process was aborted. " & Cstr(rtn)
'The & Cstr(rtn) will display the number returned by CopyStuff
'After you've got your script running, you may want to remove this feature
end if
'Cleanup
if not fle1 is nothing then set fle1 = nothing
if not fle2 is nothing then set fle2 = nothing
if not objFSO is nothing then set objFSO = nothing
end Sub
' COPY FUNCTION
function CopyStuff()
set objFSO = CreateObject("Scripting.Fi
'I've included error handling after each step
if err.number <> 0 then
msgbox "Error in Creating Object: " & err.number & "; " & err.description
CopyStuff = 0 'Returns this number
exit function 'Stop processing, go back to Main
end if
if not objFSO.FileExists(strPath)
msgbox "The " & strPath & " file was not found on this computer"
CopyStuff = 2
exit Function
' END FUNCTION
end if
if objFSO.FileExists(strFldr)
objFSO.DeleteFile(strFldr)
end if
set fle1 = objFSO.OpenTextFile(strPat
if err.number <> 0 then
msgbox "Error opening " & strPath & ": " & err.number & "; " & err.description
CopyStuff = 3
exit function
end if
set fle2 = objFSO.CreateTextFile(strF
if err.number <> 0 then
msgbox "Error creating temp ini: " & err.number & "; " & err.description
CopyStuff = 4
exit function
end If
'*************************
'Here's the code that does the copying
'
'Here is the string replacement Logic
'
'*************************
Do while not fle1.AtEndofStream
strLinePrior = strLine
strLine = fle1.ReadLine
strLine = Replace(strLine,"*U*00401*
strLine = Replace(strLine,"*X*004010
strLine = Replace(strLine,"ST*837*00
strLine = Replace(strLine,"34-071444
strLine = Replace(strLine,"OH*44122"
' Place of Service Qualifier Added
strLine = Replace(strLine,"11::1*Y*A
strLine = Replace(strLine,"12::1*Y*A
strLine = Replace(strLine,"53::1*Y*A
' Drop Insurance Type
strLine = Replace(strLine,"*MB****ZZ
strLine = Replace(strLine,"*MC****ZZ
strLine = Replace(strLine,"OI***Y*C*
strLine = Replace(strLine,"REF*IG*S"
'=========================
'Here's the code that drops the REF AND DTM segments
'and decrements the segment counter by 1
if Left(strLine, 6) <> "REF*87" AND left(strLinePrior,3) <> "AMT" AND left(strLine,3) <> "SE*" Then
fle2.WriteLine strLine
strLinePrior = strLine
Else
if left(strLine,3) = "SE*"Then
strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
fle2.WriteLine strLine
END If
END IF
'=========================
loop
if err.number <> 0 then
msgbox "Error transfering data: " & err.number & "; " & err.description
CopyStuff = 5
fle1.close
fle2.close
exit function
end if
fle1.close
set fle1 = nothing
fle2.close
set fle2 = nothing
if err.number <> 0 then
msgbox "Error replacing " & strPath & " with new file: " & err.number & "; " & err.description
CopyStuff = 6
else
CopyStuff = 1 'Remember that in Main, a "1" means successful
end if
end function
Okay, I'll work that up a bit, will take a little bit, I want to try and clean it a bit and remove the "global variables" as much as possible.
~bp
~bp
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
ASKER
I changed
strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
To
strLine = "SE*" & objFile2.Line -2 & "*0001" ' Reset SE Segment for dropped records
It works great!
strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
To
strLine = "SE*" & objFile2.Line -2 & "*0001" ' Reset SE Segment for dropped records
It works great!
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Rob Sampson truly deserves genius status.
No. You could archive it to another folder if you want....or do you just want it deleted?
To have it deleted, change this:
For Each objFile In objFSO.GetFolder(strInputF older).Fil es
strInputFile = objFile.Path
strOutputFile = strOutputFolder & objFile.Name
CopyStuff strInputFile, strOutputFile
Next
to this:
For Each objFile In objFSO.GetFolder(strInputF older).Fil es
strInputFile = objFile.Path
strOutputFile = strOutputFolder & objFile.Name
CopyStuff strInputFile, strOutputFile
objFile.Delete
Next
Rob.
To have it deleted, change this:
For Each objFile In objFSO.GetFolder(strInputF
strInputFile = objFile.Path
strOutputFile = strOutputFolder & objFile.Name
CopyStuff strInputFile, strOutputFile
Next
to this:
For Each objFile In objFSO.GetFolder(strInputF
strInputFile = objFile.Path
strOutputFile = strOutputFolder & objFile.Name
CopyStuff strInputFile, strOutputFile
objFile.Delete
Next
Rob.
ASKER
Worked great!
We are very grateful.
We are very grateful.