Link to home
Start Free TrialLog in
Avatar of GessWurker
GessWurker

asked on

Adjust vbscript to remove unwanted returns

I'm using some vbscript to manipulate csv files. Unfortunately, some of the csv input has unwanted returns in it. I'd like to add code to the script that will remove these unwanted returns, replace them with a single space, and then replace all instances of double-spaces with a single space. What do I need to add to the attached code to achieve this? And where best to add it? I've included the code, some sample input, and the sample replacement list files the code uses.

Note: The first column of the csv input MUST include an abbreviated state (or territory) name. If it does not, we know there's a line break problem that we need to fix. And: We can use the StateList.txt file to validate entries in the first column.

Function pd(n, totalDigits) 
        if totalDigits > len(n) then 
            pd = String(totalDigits-len(n),"0") & n 
        else 
            pd = n 
        end if 
End Function 

dteStart = Now


Dim Today

Today = pd(Month(date()),2) & "-" & _ 
        pd(Day(date()),2) & "-" & _ 
        Year(date())

Dim FileSys, MoveFile, i
Dim MyData, strData(), strStateData(), SplitUsingEqualTo, Search, strLine, strStateLine
Dim aCell

Const xlCellTypeLastCell = 11
Const xlCSV = 6
Const ForReading = 1

'~~> Change Path Here
InPutDirName = "C:\A_Testing\csvInput\"
OutPutDirName = "C:\A_Testing\csvOutput\"
ProcessedDirName = "C:\A_Testing\csvProcessed\"
ReplacementTextFile = "C:\A_Testing\csvProcessed\ReplacementList.txt"
StateTextFile = "C:\A_Testing\csvProcessed\StateList.txt"

Set objExcel = CreateObject("Excel.Application")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objTextFile = FileSys.OpenTextFile(ReplacementTextFile, ForReading)
Set objStateTextFile = FileSys.OpenTextFile(StateTextFile, ForReading)

Set FileRetriever = FileSys.GetFolder(InPutDirName)
Set FileNames = FileRetriever.Files
 
i = 0

Do Until objTextFile.AtEndOfStream
    ReDim Preserve strData(i)
    strData(i) = objTextFile.ReadLine
    i = i + 1
Loop
objTextFile.Close
 
j = 0

Do Until objStateTextFile.AtEndOfStream
    ReDim Preserve strStateData(j)
    strStateData(j) = objStateTextFile.ReadLine
    j = j + 1
Loop
objStateTextFile.Close

For Each F In FileNames
    If LCase(Right(CStr(F.Name), 4)) = ".csv" Then
        Set objWorkbook = objExcel.Workbooks.Open(InPutDirName & F.Name)
        Set objSheet = objWorkbook.Sheets(1)
        topicName = Replace(F.Name,".csv","")
        lastrow = objSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        objSheet.Columns(1).Insert
        objSheet.Cells(1, "A") = "RecordID"
        objSheet.Range("A2:A" & lastrow).FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]"
        objSheet.Cells(1, "Y") = "Topic"
        objSheet.Range("Y2:Y" & lastrow).FormulaR1C1 = topicName         
        
        objExcel.DisplayAlerts = False
        
        For Each strLine In strData
            SplitUsingEqualTo = Split(strLine, "=") 
            objSheet.Columns(24).Replace SplitUsingEqualTo(0), SplitUsingEqualTo(1),2,1,True
  Next
  
       objSheet.Range("A2:A" & lastrow).value = objSheet.Range("A2:A" & lastrow).value
        For Each strStateLine In strStateData
            SplitUsingEqualTo = Split(strStateLine, "=") 
            objSheet.Columns(2).Replace SplitUsingEqualTo(0), SplitUsingEqualTo(1),1,1,True
            
        Next
        
        objWorkbook.SaveAs OutPutDirName & Replace(F.Name,".csv"," " & Today & ".csv"), xlCSV
				objWorkbook.Close (True)
				objExcel.DisplayAlerts = True
				objExcel.Quit
				FileSys.MoveFile InPutDirName & F.Name , ProcessedDirName & Replace(F.Name,".csv"," processed " & Today & ".csv")
        'Set MoveFile = FileSys.GetFile(InPutDirName & F.Name)
        'MoveFile.Move (ProcessedDirName)
    End If
Next

dteEnd = Now

MsgBox "Finished in " & DateDiff("s", dteStart, dteEnd) & " seconds."

Open in new window

Employee-Leave.csv ReplacementList.txt StateList.txt

Avatar of SiddharthRout
SiddharthRout
Flag of India image

Try this

Insert this code in line 84.

    Dim acell As Range
    
    Do
        Set acell = objSheet.Cells.Find(What:="  ", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not acell Is Nothing Then
            acell.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        End If
    Loop Until acell Is Nothing
    
    Do
        Set acell = objSheet.Cells.Find(What:=Chr(10), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        objSheet.Columns(1).Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Loop Until acell Is Nothing

Open in new window


Sid
Avatar of GessWurker
GessWurker

ASKER

Sid: Tried it. Got following:

Line: 86
Char: 9
Error: Name redefined
Code: 800A0411
Source: Microsoft VBScript compilation error

Now I'll see if I can figure it out.
ah... can't re-use that variable?
Oops i forgot you were doing this in vbscript.

Replace

Dim acell As Range

by this

Dim acell As Object

An also declare these at the top

Const xlvalues = -4163
Const xlPart = 2
Const xlByRows = 1
Const xlNext = 1

Now try.

Sid

Sorry

Dim acell

and not

Dim acell As Object

Sid
Sid: I still get "Name redefined" error
Still "Name redefined" error
Post the latest code that you are using and also tell me the line number.

Sid
To clarify:

Dim acell as Range   --> doesn't work
Dim acell as Object   --> doesn't work
Dim acell   --> doesn't work
Can you post the complete code so that I can test?

Sid
Your const entries towards the top. Your other code additions around line 90. Cheers!
Function pd(n, totalDigits) 
        if totalDigits > len(n) then 
            pd = String(totalDigits-len(n),"0") & n 
        else 
            pd = n 
        end if 
End Function 

dteStart = Now


Dim Today

Today = pd(Month(date()),2) & "-" & _ 
        pd(Day(date()),2) & "-" & _ 
        Year(date())

Dim FileSys, MoveFile, i
Dim MyData, strData(), strStateData(), SplitUsingEqualTo, Search, strLine, strStateLine
Dim aCell

Const xlvalues = -4163
Const xlPart = 2
Const xlByRows = 1
Const xlNext = 1
Const xlCellTypeLastCell = 11
Const xlCSV = 6
Const ForReading = 1

'~~> Change Path Here
InPutDirName = "C:\A_Testing\csvInput\"
OutPutDirName = "C:\A_Testing\csvOutput\"
ProcessedDirName = "C:\A_Testing\csvProcessed\"
ReplacementTextFile = "C:\A_Testing\csvProcessed\ReplacementList.txt"
StateTextFile = "C:\A_Testing\csvProcessed\StateList.txt"

Set objExcel = CreateObject("Excel.Application")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objTextFile = FileSys.OpenTextFile(ReplacementTextFile, ForReading)
Set objStateTextFile = FileSys.OpenTextFile(StateTextFile, ForReading)

Set FileRetriever = FileSys.GetFolder(InPutDirName)
Set FileNames = FileRetriever.Files
 
i = 0

Do Until objTextFile.AtEndOfStream
    ReDim Preserve strData(i)
    strData(i) = objTextFile.ReadLine
    i = i + 1
Loop
objTextFile.Close
 
j = 0

Do Until objStateTextFile.AtEndOfStream
    ReDim Preserve strStateData(j)
    strStateData(j) = objStateTextFile.ReadLine
    j = j + 1
Loop
objStateTextFile.Close

For Each F In FileNames
    If LCase(Right(CStr(F.Name), 4)) = ".csv" Then
        Set objWorkbook = objExcel.Workbooks.Open(InPutDirName & F.Name)
        Set objSheet = objWorkbook.Sheets(1)
        topicName = Replace(F.Name,".csv","")
        lastrow = objSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        objSheet.Columns(1).Insert
        objSheet.Cells(1, "A") = "RecordID"
        objSheet.Range("A2:A" & lastrow).FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]"
        objSheet.Cells(1, "Y") = "Topic"
        objSheet.Range("Y2:Y" & lastrow).FormulaR1C1 = topicName         
        
        objExcel.DisplayAlerts = False
        
        For Each strLine In strData
            SplitUsingEqualTo = Split(strLine, "=") 
            objSheet.Columns(24).Replace SplitUsingEqualTo(0), SplitUsingEqualTo(1),2,1,True
  Next
  
       objSheet.Range("A2:A" & lastrow).value = objSheet.Range("A2:A" & lastrow).value
        For Each strStateLine In strStateData
            SplitUsingEqualTo = Split(strStateLine, "=") 
            objSheet.Columns(2).Replace SplitUsingEqualTo(0), SplitUsingEqualTo(1),1,1,True
            
        Next
    
    Dim acell
    
    Do
        Set acell = objSheet.Cells.Find(What:="  ", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not acell Is Nothing Then
            acell.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        End If
    Loop Until acell Is Nothing
    
    Do
        Set acell = objSheet.Cells.Find(What:=Chr(10), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        objSheet.Columns(1).Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Loop Until acell Is Nothing        
        objWorkbook.SaveAs OutPutDirName & Replace(F.Name,".csv"," " & Today & ".csv"), xlCSV
				objWorkbook.Close (True)
				objExcel.DisplayAlerts = True
				objExcel.Quit
				FileSys.MoveFile InPutDirName & F.Name , ProcessedDirName & Replace(F.Name,".csv"," processed " & Today & ".csv")
        'Set MoveFile = FileSys.GetFile(InPutDirName & F.Name)
        'MoveFile.Move (ProcessedDirName)
    End If
Next

dteEnd = Now

MsgBox "Finished in " & DateDiff("s", dteStart, dteEnd) & " seconds."

Open in new window

Remove   Dim acell from line 89.

You have already defined it in Line 20 :)

Now try

Sid
DOH!  Pretty sure I mentioned that!!  

No worries... I'll give it another shot...
Ok. Got another error. Expected ')' at line 93.

I've got a request: Can you run the code first and verify that it works? Once you've verified working code, please post it.

Thanks!
Ok. let me download all the files.

Sid
Please check if the output is correct? If it is then I will upload the code.

Sid
Employee-Leave-02-11-2011.csv
Hi Sid. Sorry for the delay.

Nope. We're not there yet. Your output:

line 9:referred to SENATE Committee on RULES.MasterLaborRule;PSL;WorkersComp;WorkersComp,referred to SENATE Committee on RULES.,Master,,LaborRule;PSL;WorkersComp;WorkersComp,,,,,,,,,,,,,,,,,,,,Employee-Leave

1st col should always contain RecordID (e.g., AR2011H1024, AZ2011S1264, CA2011A11, etc)
Hmm... Your input file has that line.

What should I be doing in the code? Delete that line?

Sid
No. That line is an example of the problem. It actually belongs to the previous line. An unwanted line-break in the previous line bumped the 2nd half of line 8 down do line 9. Col 1 should always contain a record id. If we ever come across a col 1 that doesn't contain a record ID, we know there's an unwanted line break in the previous line.
Oh Ok I get it.

So in the above file it belongs to Line 8 Column T?

Sid
Exactly
One last question before I update the code.

In the current output above, All the data above in col 9 will go into Col T or will be divided into other columns?

Sid
I also realized, do you have a set format for the record ID?

For example First 2 should be letter and then followed by 4 numbers and then 1 letter?

The reason why I ask is so that I know how to identify a record ID in the code.

Sid
The RecordID is concatenated from the first 5 columns of the original input. See the first 5 cols of employee leave.csv attached to my initial post.
Please confirm if the output is correct?

Sid
Employee-Leave-02-15-2011.csv
The sample looks good, Sid! Now let's see that code so I can give it a workout!  :-)
ASKER CERTIFIED SOLUTION
Avatar of SiddharthRout
SiddharthRout
Flag of India 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
Sid: It does the job! Sure seems to work hard at it (add quite a bit of processing time), but it completes successfully! Thanks a bunch!  Cheers - gesswurker