Set objConnXLS = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set OutFile = FileSys.OpenTextFile("1.csv", 8, true)
objConnXLS.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=1.xls;Extended Properties=""Excel 8.0;HDR=YES;IMEX=1;"";"
objRecordSet.Open "SELECT * FROM [Лист1$]", objConnXLS, 3, 3
If Not objRecordSet.EOF AND Not objRecordSet.BOF Then
	objRecordSet.MoveFirst
	For intColumns = 0 To (objRecordset.Fields.Count - 1)
		If intColumns < objRecordset.Fields.Count - 1 Then
			strDelimiter = ";"
		Else
			strDelimiter = ""
		End If	
        	strHeader = strHeader + objRecordset.Fields.Item(intColumns).Name & strDelimiter
    	Next
	OutFile.WriteLine strHeader
	arrRecords = objRecordSet.GetRows
	For i = 0 To UBound(arrRecords, 2)
		strRow = ""
		For intColumns = 0 To (objRecordset.Fields.Count - 1)
			If intColumns < objRecordset.Fields.Count - 1 Then
				strDelimiter = ";"
			Else
				strDelimiter = ""
			End If
			strRow = strRow & arrRecords(intColumns, i) & strDelimiter
		Next
		OutFile.WriteLine strRow
	Next	
End If

OutFile.Close
objRecordSet.Close
objConnXLS.Close
Set objRecordSet = Nothing
Set objConnBank = Nothing

option explicit

dim rs, ConnectionString, s, i, fso, f, Separator
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile("c:\1\1.csv", True)

Set rs = CreateObject("ADODB.Recordset")
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\1\1.xls;User ID=Admin;Password=;Extended Properties=""Excel 8.0;IMEX=1""" 'IMEX=1 нужен, чтобы корректно прочитался столбец, если в нем идут вмеперешку ячейки с числами, датами, строками...

rs.Open "select * from [Лист1$]", ConnectionString

s = ""
Separator = ";"

'Заголовок
for i = 0 to rs.Fields.Count - 1
	s = s & CStr(rs.Fields(i).Name) & Separator
next
f.WriteLine(s)

'Бегаем по данным
while not rs.EOF
		s = ""
		for i = 0 to rs.Fields.Count - 1
			s = s & CStr(rs.Fields(i).Value) & Separator
		next
	f.WriteLine(s)
	rs.MoveNext
wend

rs.Close
Set rs = Nothing

f.Close
set f = nothing
set fso = nothing

Set objConnXLS = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\")
Set colFiles = objFolder.Files
For Each objFile in colFiles
If UCase(objFSO.GetExtensionName(objFile.name)) = "XLS" Then
Set OutFile = objFSO.OpenTextFile(objFSO.GetBaseName(objFile.Name) & ".csv", 8, true)
objConnXLS.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & objFile.Name & ";Extended Properties=""Excel 8.0;HDR=YES;IMEX=1;"";"
objRecordSet.Open "SELECT * FROM [Лист1$]", objConnXLS, 3, 3
If Not objRecordSet.EOF AND Not objRecordSet.BOF Then
    objRecordSet.MoveFirst
    For intColumns = 0 To (objRecordset.Fields.Count - 1)
        If intColumns < objRecordset.Fields.Count - 1 Then
            strDelimiter = ";"
        Else
            strDelimiter = ""
        End If  
            strHeader = strHeader + objRecordset.Fields.Item(intColumns).Name & strDelimiter
        Next
    OutFile.WriteLine strHeader
    arrRecords = objRecordSet.GetRows
    For i = 0 To UBound(arrRecords, 2)
        strRow = ""
        For intColumns = 0 To (objRecordset.Fields.Count - 1)
            If intColumns < objRecordset.Fields.Count - 1 Then
                strDelimiter = ";"
            Else
                strDelimiter = ""
            End If
            strRow = strRow & arrRecords(intColumns, i) & strDelimiter
        Next
        OutFile.WriteLine strRow
    Next    
End If
OutFile.Close
objRecordSet.Close
objConnXLS.Close
End If
Next
Set objRecordSet = Nothing
Set objConnXLS = Nothing