Working with CSV files using VBScript

[thockman]

Here is a vbscript to manipulate csv files. It takes csv files in a directory and combines them into a fixed width file.

Code: Select all

' Name:        csv.vbs
' Author:    Troy Hockman
' Date Created:    07/21/05
' Description:    This script will combine multiple csv files into one formatted csv file

Option Explicit
Dim oFileSys, oFolder, oFiles, FileTxt, xFile, sHeader, slItems, sFooter, sLocInput, sLocOutput, sLocArchive
Dim iFNum, iRS, iCases, iTotal, SF, RS, sTime, aFile, sTmpDate, sDDate, sMonth, sYear, sDay, sCaseQty, sTmpField, sLength
Dim iL, sFixedWidth, sCases, sDesc, sItemCost, sItemTotal, sPONum, sFixChar, sStoreNum, sType
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Variables
sLocInput = "\\server\share\folder\input"
sLocOutput = "\\server\share\folder\output"
sLocArchive = "\\server\share\folder\archive"
 
Main()
Completed()
wscript.quit
 
Sub Main()
    Set oFilesys = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFileSys.GetFolder(sLocInput)
    Set oFiles = oFolder.Files
    ' See if already running.
    If oFileSys.FileExists(sLocOutput & "\running") Then wscript.Echo "Already Running!", wscript.quit End If
    ' Create file flag showing running.
    Set FileTxt = oFileSys.OpenTextFile(sLocOutput & "\running", ForAppending, True)
    FileTxt.WriteLine("Running")
    FileTxt.Close 
    iFNum = 0
    For Each xFile in oFiles 
        ' Read from csv file.
        ' Check for char in file name we can not read.
        If instr(xFile.Name,"-") or instr(xFile.Name," ") Then
            wscript.Echo "Can not handle file name!"
            Completed()
        End If
        SF="Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sLocInput & ";Extended Properties=""TEXT;HDR=NO;FMT=Delimited;"""
        set RS=createobject("adodb.recordset")
        RS.open "SELECT * FROM " & xFile.Name, SF
        RS.MoveFirst
        iRS = 0
        iCases = 0
        iTotal = 0
        sHeader = ""
        sLitems = ""
        sFooter = ""
        While NOT RS.EOF
            ' Build Header.  Parse the first 5 lines for header.
            While iRS <= 5
                If iRS = 0 Then
                    sStoreNum = FixedWidth(RS(1),5,"i")
                    sHeader = sHeader & sStoreNum & ","
                End If
                If iRS = 1 Then    sPONum = RS(3) End If
                If iRS = 2 Then     
                    sTmpDate = RS(1)
                    sDDate = Trim(ConvertDate(sTmpDate))
                    sHeader = sHeader & sDDate & "," & sPONum & vbcrlf
                End If
                iRS = iRS + 1
                RS.MoveNext
            WEnd
            ' Build line items.
            sCaseQty = FixedWidth(RS(3),5,"i")
            sCases = FixedWidth(RS(4),5,"s")
            sDesc = FixedWidth(replace(RS(2),",",""),40,"s")
            sItemCost = FixedWidth(RS(5),10,"i")
            sItemTotal = FixedWidth(RS(6),10,"i")
            sLItems = sLItems & "UD," & replace(RS(0),"-","") & "," & replace(RS(1),"-","") & "," & sCaseQty & "," & sCases & "," & _
                    sDesc & "," & sItemCost & "," & sItemTotal & vbcrlf
            ' Build totals
            iCases = iCases + RS(3)
            iTotal = iTotal + RS(6)
            RS.MoveNext
        WEnd
        ' Add Identifier to header and footer.
        sHeader = "UH," & sHeader & vbcrlf
        sFooter = "UT," & FixedWidth(iCases,7,"i") & vbcrlf
        RS.close
        Set FileTxt = oFileSys.OpenTextFile(sLocOutput & "\chorders.txt", ForAppending, True)
        FileTxt.WriteLine(sHeader & sLItems & sFooter)
        FileTxt.Close 
        sTime = replace(time(),":","-")
        ' Archive files for possible review stamping time on end.
        oFileSys.MoveFile sLocInput & "\" & xFile.Name , sLocArchive & "\" & replace(xFile.Name,".csv","-") & sTime & ".csv"
        iFNum = iFNum + 1
    Next
End Sub
 
Function ConvertDate(sTmpDate)
    ' Build date to year month day
    sMonth = lCase(left(sTmpDate,instr(sTmpDate," ") - 1))
    Select Case sMonth
        Case "january"
            ConvertDate = Right(sTmpDate,5) & "01" & Mid(sTmpDate,9,2)
        Case "febuary"
            ConvertDate = Right(sTmpDate,5) & "02" & Mid(sTmpDate,9,2)
        Case "march"
            ConvertDate = Right(sTmpDate,5) & "03" & Mid(sTmpDate,7,2)
        Case "april"
            ConvertDate = Right(sTmpDate,5) & "04" & Mid(sTmpDate,7,2)
        Case "may"
            ConvertDate = Right(sTmpDate,5) & "05" & Mid(sTmpDate,5,2)
        Case "june"
            ConvertDate = Right(sTmpDate,5) & "06" & Mid(sTmpDate,6,2)
        Case "july"
            ConvertDate = Right(sTmpDate,5) & "07" & Mid(sTmpDate,6,2)
        Case "august"
            ConvertDate = Right(sTmpDate,5) & "08" & Mid(sTmpDate,8,2)
        Case "september"
            ConvertDate = Right(sTmpDate,5) & "09" & Mid(sTmpDate,11,2)
        Case "october"
            ConvertDate = Right(sTmpDate,5) & "10" & Mid(sTmpDate,9,2)
        Case "november"
            ConvertDate = Right(sTmpDate,5) & "11" & Mid(sTmpDate,10,2)
        Case "december"
            ConvertDate = Right(sTmpDate,5) & "12" & Mid(sTmpDate,10,2)
    End Select
End Function
 
Function FixedWidth(sTmpField,sFLength,sType)
    ' Fixed width for fields if needed and field type
    sFixedWidth = ""
    sType = lCase(sType)
    If sType = "s" Then
        sFixChar = " "
    ElseIf sType = "i" Then
        sFixChar = "0"
    End If
    For iL = Len(Trim(sTmpField)) To sFLength
        if iL > Len(sTmpField) Then sFixedWidth = sFixedWidth & sFixChar End If
    Next
    FixedWidth = sFixedWidth & sTmpField
End Function
 
Sub Completed()
    ' Remove running file flag and close objects.
    Set aFile = oFileSys.GetFile(sLocOutput & "\running")
    aFile.Delete
    wscript.echo iFNum & " file(s) processed."
    Set oFileSys = Nothing
    Set FileTxt = Nothing
    wscript.quit
End Sub