Link to home
Start Free TrialLog in
Avatar of tim44202
tim44202Flag for United States of America

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*00501*")
                  strLine = Replace(strLine,"*X*004010X098A1","*X*005010X222A1")
                  strLine = Replace(strLine,"ST*837*0001","ST*837*0001*005010222")
                  strLine = Replace(strLine,"34-0714441","340714441")
                  strLine = Replace(strLine,"OH*44122","OH*441225715")
                  ' Place of Service Qualifier Added
                  strLine = Replace(strLine,"11::1*Y*A*Y*A*C","11:B:1*Y*A*Y*I*P")
                  strLine = Replace(strLine,"12::1*Y*A*Y*A*C","53:B:1*Y*A*Y*I*P")
                  strLine = Replace(strLine,"53::1*Y*A*Y*A*C","53: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
            
''''**********************************************************************************************
Avatar of celazkon
celazkon
Flag of Czechia image

Can you use powershell for the copying?
Avatar of tim44202

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.
Avatar of dougaug
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

Open in new window

Avatar of Bill Prew
Bill Prew

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"

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

Open in new window

~bp
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.FileSystemObject") '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(strPath) 'Open
                if err.number <> 0 then       
                      msgbox "Error opening " & strPath & ": " & err.number & "; " & err.description
                      CopyStuff = 3
                      exit function
                end if
          set fle2 = objFSO.CreateTextFile(strFldr) '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*00501*")
                  strLine = Replace(strLine,"*X*004010X098A1","*X*005010X222A1")
                  strLine = Replace(strLine,"ST*837*0001","ST*837*0001*005010222")
                  strLine = Replace(strLine,"34-0714441","340714441")
                  strLine = Replace(strLine,"OH*44122","OH*441225715")
                  ' Place of Service Qualifier Added
                  strLine = Replace(strLine,"11::1*Y*A*Y*A*C","11:B:1*Y*A*Y*I*P")
                  strLine = Replace(strLine,"12::1*Y*A*Y*A*C","53:B:1*Y*A*Y*I*P")
                  strLine = Replace(strLine,"53::1*Y*A*Y*A*C","53: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
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
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
There was an error:
 Attached is a screen print

2011-12-13-170058.bmp
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
New compile problem:
 see attached
2011-12-13-173110.bmp
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!
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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(strInputFolder).Files
      strInputFile = objFile.Path
      strOutputFile = strOutputFolder & objFile.Name
      CopyStuff strInputFile, strOutputFile
Next

to this:
For Each objFile In objFSO.GetFolder(strInputFolder).Files
      strInputFile = objFile.Path
      strOutputFile = strOutputFolder & objFile.Name
      CopyStuff strInputFile, strOutputFile
      objFile.Delete
Next


Rob.
Worked great!

We are very grateful.