GessWurker
asked on
adjust vbscript to create additional CSV file containing column contents only
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
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."
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
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.
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
ASKER
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.
RecIDDirName = "C:\A_Testing\csvRecID\"
I need the new file to end up in a separate folder.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks, Rob!
Rob.