' NAME: CSV2Excel.vbs
'
' AUTHOR: Alan dot Kaplan at va dot gov
' DATE  : 10/5/2009
'
' COMMENT: Converts comma delimited file to Excel
' Run from GUI or 
' Syntax CSV2Excel.vbs FilePath.csv [True/False]
' With True/False being whether you want to delete original
' Note Line 40 has default behavior for this and for drag and drop operations
' 
' 11/13/2009 added support for XLSX, see line 25 to set saveAs type
'==========================================================================
Option Explicit 
dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
Const xlnormal = -4143 
Dim fso, oXL, objRange, bbatch, bDelete
Set fso = CreateObject("Scripting.FileSystemObject")
Dim bDropDragDelete
Dim strFileName, strFilePath, strExt, strSaveAsExt, iFormatVal
Dim oWS	

'Pick save as type (no period)
strSaveAsExt = "xlsx" '2007
'strSaveAsExt = "xls" '20003

Select Case lcase(strSaveAsExt)
 	Case "xlsb"
 		iFormatVal = 50
	Case "xlsx"
		iFormatVal = 51
	Case "xlsm"
		iFormatVal = 52
 	Case "xls"
 		iFormatVal = 56
End Select

'Default for delete original file when drop and drag or only one parameter passed
bDropDragDelete = True

'script uses vbYes/No, so convert
If bDropDragDelete = True Then 
	bDropDragDelete = vbYes
Else
	bDropDragDelete = vbNo
End If 
	

Select Case WScript.Arguments.Count
	Case 0
		strFileName = ExcelOpenDialog("Choose a comma delimted file", _
		"Comma Delmited Files (*.csv; *.txt),*.csv;*.txt",strFilePath ) 
	
		bDelete = msgBox ("Delete file after converting?",vbYesNoCancel, "Delete Original?")
		If bDelete = vbCancel Then WScript.Quit
	Case 1	
		strFileName = WScript.Arguments(0)
		bbatch = True 
		bDelete = bDropDragDelete
	Case 2	
		If UCase(WScript.Arguments(1)) = "TRUE" Then 
			bDelete = vbYes
		Else	'Use default
			bDelete = bDropDragDelete
		End If 
End Select 

If Not fso.FileExists(strFileName) Then WScript.Quit

''On Error Resume Next
Set oXL = CreateObject("Excel.Application")

If Err <> 0 Then 'Excel not installed
	Err.Clear
	''On Error GoTo 0
	MsgBox "To convert to Excel, you must have Excel installed.",vbCritical + vbOKOnly,"Fatal Error"
	WScript.Quit
End If 

oXL.DisplayAlerts=False ' don't display overwrite prompt.
oXL.Workbooks.Open(strFileName)

'Use Text to columns
oXL.Columns("A:A").Select
oxl.Selection.TextToColumns , 1, , , , , 1

'AutoFit
Set objRange = oXL.Worksheets(1).UsedRange
objRange.EntireColumn.Autofit()

Set oWS = oXL.Worksheets(1)
oWS.Activate

oxl.Range("A1").Select 'unselect column
strext =  fso.getextensionname(strFileName)
oXL.ActiveWorkBook.SaveAs replace(strFileName,strExt,strSaveAsExt),iFormatVal,,,,,,,True 'overwrite existing
oXL.ActiveWorkBook.Close
oXL.Quit


If bDelete = vbYes Then
	fso.DeleteFile strFileName,True
	WScript.Sleep 1000
End If 

If Not bbatch Then wshshell.popup "File converted.",5,"Done"
        
Function ExcelOpenDialog( sPrompt, sFilter, strDefaultFile ) 
	'Based on code by Michael Hardt 
   	'http://www.softimage.com/community/xsi/discuss/archives/xsi.archive.0111/msg00066.htm
	Dim strButtonText, bMulti
	''On Error Resume Next 
	Set oXL = CreateObject("Excel.Application") 
	If Err =  0 Then 
		Dim sFile 
	   	sFile = oXL.GetOpenFilename ( sFilter, , sPrompt,strButtonText,bMulti ) 	   	
		'Cancel or no file name? 
	   	If sFile <> False Then 
	      	ExcelOpenDialog = sFile 
	   	Else 
	     	 Wscript.quit
	   	End If 
	 Else
	 	Err.Clear
		ExcelOpenDialog = InputBox(sPrompt,"Open what file",strDefaultFile)
	 End If 
	''On Error GoTo 0
End Function