• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 197
  • Last Modified:

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
            
''''**********************************************************************************************
0
tim44202
Asked:
tim44202
  • 8
  • 5
  • 2
  • +2
5 Solutions
 
celazkonCommented:
Can you use powershell for the copying?
0
 
tim44202Author Commented:
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.
0
 
dougaugCommented:
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

0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
Bill PrewCommented:
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
0
 
tim44202Author Commented:
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
0
 
Bill PrewCommented:
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
0
 
RobSampsonCommented:
Hi, I've reworked your code, taking out the error checking...I think that was overkill.  There's no reason for the process to fail if the folders and files are set up correctly.  This will read the files from the input folder, and write the output files to the output folder.

Regards,

Rob.
strInputFolder = "C:\x12 Test Files\"
strOutputFolder = "C:\x12 Test Files\OUT\"

If Right(strInputFolder, 1) <> "\" Then strInputFolder = strInputFolder & "\"
If Right(strOutputFolder, 1) <> "\" Then strOutputFolder = strOutputFolder & "\"

' Initialize strLinePrior
strLinePrior = "First*Record"

Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strOutputFolder) = False Then objFSO.CreateFolder strOutputFolder

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

WScript.Echo "Script has finished processing files in " & strInputFolder

Sub CopyStuff(ByVal strInput, strOutput)
	Set objFile1 = objFSO.OpenTextFile(strInput, 1, False)
	Set objFile2 = objFSO.CreateTextFile(strOutput, True)
	'****************************************************************************
	'Here's the code that does the copying
	'
	'Here is the string replacement Logic
	'
	'****************************************************************************
	While Not objFile1.AtEndOfStream 
		strLinePrior = strLine
		strLine = objFile1.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
			objFile2.WriteLine  strLine
			strLinePrior = strLine
		Else
			If Left(strLine,3) = "SE*" Then
				strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
				objFile2.WriteLine  strLine
			End If
		End If
		'========================================================================================================================
	Wend
	objFile1.Close
	objFile2.Close
End Sub

Open in new window

0
 
tim44202Author Commented:
There was an error:
 Attached is a screen print

2011-12-13-170058.bmp
0
 
RobSampsonCommented:
Whoops.  This line:
For Each objFile In objFSO.GetFolder(strInputFolder)

should have been:
For Each objFile In objFSO.GetFolder(strInputFolder).Files

Regards,

Rob.
strInputFolder = "C:\x12 Test Files\"
strOutputFolder = "C:\x12 Test Files\OUT\"

If Right(strInputFolder, 1) <> "\" Then strInputFolder = strInputFolder & "\"
If Right(strOutputFolder, 1) <> "\" Then strOutputFolder = strOutputFolder & "\"

' Initialize strLinePrior
strLinePrior = "First*Record"

Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strOutputFolder) = False Then objFSO.CreateFolder strOutputFolder

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

WScript.Echo "Script has finished processing files in " & strInputFolder

Sub CopyStuff(ByVal strInput, strOutput)
	Set objFile1 = objFSO.OpenTextFile(strInput, 1, False)
	Set objFile2 = objFSO.CreateTextFile(strOutput, True)
	'****************************************************************************
	'Here's the code that does the copying
	'
	'Here is the string replacement Logic
	'
	'****************************************************************************
	While Not objFile1.AtEndOfStream 
		strLinePrior = strLine
		strLine = objFile1.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
			objFile2.WriteLine  strLine
			strLinePrior = strLine
		Else
			If Left(strLine,3) = "SE*" Then
				strLine = "SE*" & fle2.Line -2 & "*0001" ' Reset SE Segment for dropped records
				objFile2.WriteLine  strLine
			End If
		End If
		'========================================================================================================================
	Wend
	objFile1.Close
	objFile2.Close
End Sub

Open in new window

0
 
tim44202Author Commented:
New compile problem:
 see attached
2011-12-13-173110.bmp
0
 
tim44202Author Commented:
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!
0
 
RobSampsonCommented:
Oops, missed that one too.  Change
                        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

Rob.
0
 
RobSampsonCommented:
Oh, good to hear! LOL!
0
 
tim44202Author Commented:
Would it be difficult to add logic to delete the input file after it is copied?
0
 
tim44202Author Commented:
Rob Sampson truly deserves genius status.
0
 
RobSampsonCommented:
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.
0
 
tim44202Author Commented:
Worked great!

We are very grateful.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 8
  • 5
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now