Solved

adjust vbscript to create additional CSV file containing column contents only

Posted on 2011-02-10
7
580 Views
Last Modified: 2012-05-11
Thanks to rorya, I've got a script (see code below) that processes csv files, manipulating text and creating new columns as necessary. I need to add (yet) another function. The script currently creates a new col 1 containing concatenated data from other columns. Now, I need to create a new csv file that contains col1 data ONLY with a header row of RecordID. That is, all other functionality of the script must stay, but now I also need to output a 2nd file containing only processed col1 data called RecordIDs.csv.

Big deal? Piece of cake? I don't know. Very heavy lifting for me though. Who can do it?

I've attached the code, a sample input file, and the text files the code reads in to make various changes to input. Topic.csv StateList.txt ReplacementList.txt
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

0
Comment
Question by:GessWurker
  • 4
  • 3
7 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 34867103
Hi, as this (potentially) processes multiple files at a time, do want each file to append to RecordIDs.csv, or do you want to make it <filename>_RecordIDs.csv or something like that?

Rob.
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 34867124
I've made it create a <filename>_RecordIDs.csv file.  I haven't tested this, but hopefully it works.

Regards,

Rob.
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
        
	    strRecordIDs = ProcessedDirName & Replace(F.Name,".csv"," " & Today & ".csv")
	    Set objRecordIDs = FileSys.CreateTextFile(strRecordIDs, True)
		For intRow = 2 To lastrow
			objRecordIDs.WriteLine objSheet.Cells(intRow, "A").Value
		Next
		objRecordIDs.Close
        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

0
 

Author Comment

by:GessWurker
ID: 34867744
Hi Rob. Thanks for your effort, but we lost the subject conversion aspect and I didn't find a second file <filename>_recordids.csv file.
0
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
LVL 65

Expert Comment

by:RobSampson
ID: 34867992
Really? I didn't change anything. All I added was lines 85 to 90.....does the code you posted still do its required functions?

Rob.
strRecordIDs = ProcessedDirName & Replace(F.Name,".csv"," " & Today & ".csv")
		Set objRecordIDs = FileSys.CreateTextFile(strRecordIDs, True)
		For intRow = 2 To lastrow
			objRecordIDs.WriteLine objSheet.Cells(intRow, "A").Value
		Next
		objRecordIDs.Close

Open in new window

0
 

Author Comment

by:GessWurker
ID: 34868275
My bad, Rob. I was looking in the wrong place for the file. Your code does the trick. That said, can we specify a folder destination for the new single column RecordID csv file? Something like:

RecIDDirName = "C:\A_Testing\csvRecID\"

I need the new file to end up in a separate folder.
0
 
LVL 65

Assisted Solution

by:RobSampson
RobSampson earned 500 total points
ID: 34868287
Absolutely.  Add
RecIDDirName = "C:\A_Testing\csvRecID\"

under this
StateTextFile = "C:\A_Testing\csvProcessed\StateList.txt"

and then change this:
strRecordIDs = ProcessedDirName & Replace(F.Name,".csv"," " & Today & ".csv")

to this
strRecordIDs = RecIDDirName & Replace(F.Name,".csv"," " & Today & ".csv")


Regards,

Rob.
0
 

Author Comment

by:GessWurker
ID: 34876839
Thanks, Rob!
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

860 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question