Tuesday, December 18, 2012

CSV to XLS -- VBS


'Convert .csv file to an .xls file
'Author – bijunator


Option Explicit
On Error Resume Next

Const xlDelimited = 1
Const xlNormal = -4143
Const xlTextFormat = 2
Const xlGeneralFormat = 1
Const xlTextQualifierNone = -4142
Const xlTextQualifierDoubleQuote = 1
Const xlYMDFormat = 5
Const xlWindows = 2
Const xlOverwriteCells = 0

Dim source_filename, destination_filename, exlObj, wBkObj, wrkShtObj
'filename = WScript.Arguments.Item(0)

source_filename = "C:\temp\my_file_name.csv"
destination_filename = "C:\temp\my_file_name_"

Set exlObj = CreateObject("Excel.Application")
exlObj.Application.DisplayAlerts = False
exlObj.Application.Visible = False
Set wBkObj = exlObj.workbooks.Add()
Set wrkShtObj = wBkObj.Worksheets(1)

With wrkShtObj.QueryTables.Add("TEXT;" & filename, wrkShtObj.Range("$A$1"))
 .FieldNames = True
 .RowNumbers = False
 .FillAdjacentFormulas = False
 .RefreshOnFileOpen = False
 .RefreshStyle = xlOverwriteCells
 .SavePassword = False
 .SaveData = True
 .AdjustColumnWidth = False
 .RefreshPeriod = 0
 .TextFilePromptOnRefresh = False
 .TextFilePlatform = 65001
 .TextFileStartRow = 1
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierNone
 .TextFileConsecutiveDelimiter = False
 .TextFileTabDelimiter = False
 .TextFileSemicolonDelimiter = True
 .TextFileCommaDelimiter = False
 .TextFileSpaceDelimiter = False
 .TextFileColumnDataTypes = Array(1,1,5,1,1,1,2,2,1,2,1,2) 'indicates 12 columns where 1 are general format, 2 are text format and 5 is date in YMD format
 .TextFileTrailingMinusNumbers = True
 .Refresh False
end with
    wBkObj.ActiveSheet.UsedRange.EntireColumn.Autofit()  
    wBkObj.ActiveSheet.Name = "my_sheet_name"
    wBkObj.ActiveSheet.Columns("C").Select
    exlObj.Selection.NumberFormat = "yyyy-mm-dd"
    wBkObj.SaveAs  destination_filename + CStr(Year(Date)) + CStr(Month(Date)) + CStr(Day(Date)) + "_"+ CStr(Hour(Time)) +CStr(Minute(Time))+CStr(Second(Time)), xlNormal
    exlObj.Quit

If Err.Number <> 0 Then
Msgbox "Error : " & Err.Description
Err.Clear
End If
WScript.Quit

No comments:

Post a Comment