'This VBS consolidates all worksheets in a excel file and outputs as a csv/text file
Dim conn
Dim Connstr
Dim rs, strSQL
Dim fieldIdx
Dim fileName
Dim recIdx
dim fs,fname
dim linetxt
dim separator
dim schemars
dim headerFlag
dim inputFile
dim outputFile
dim workDir
defaultDir = "C:\"
inputFile = "C:\input.xlsx"
outputFile = "output.csv"
Connstr ="Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=""DSN=Excel Files;DBQ=" & inputFile &";DefaultDir=" & defaultDir &";DriverId=1046;MaxBufferSize=2048;PageTimeout=5;"""
Set conn = CreateObject("adodb.connection")
conn.Open Connstr
Set schemars = CreateObject("adodb.recordset")
Set schemars = conn.OpenSchema(20)
Set rs = CreateObject("ADODB.Recordset")
set fs=CreateObject("Scripting.FileSystemObject")
set fname=fs.CreateTextFile(outputFile,true)
headerFlag = 0
'For all worksheets in the excel file
Do until schemaRs.eof
'Process worksheet only. Worksheet name must be ended with a $ sign
'https://support.microsoft.com/en-us/kb/257819
if right(schemaRs(2),2) = "$'" then
strSQL = "select * from ["& schemaRs(2) & "]"
On Error resume next
set rs = conn.execute(strSQL)
if err.number = 0 then
if headerFlag = 0 then
fname.write printHeader(rs)
headerFlag = 1
end if
fname.write printData(rs, schemaRs(2))
rs.close
end if
On Error Goto 0
end if
schemaRs.movenext
Loop
fname.Close
set fname=nothing
set fs=nothing
conn.Close
msgbox "Complete"
function printHeader(rs)
Dim fieldIdx
Dim returnVal
Dim separator
separator = vbtab
returnVal = "Index"
For fieldidx = 0 to rs.fields.count -1
returnVal = returnVal & separator & rs.fields(fieldidx).name
next
printHeader = returnVal
end function
function printData(rs, idx)
Dim returnVal
Dim linetxt
Dim separator
rs.movenext
Do until rs.eof
'Add the worksheet name as index in the first column
linetxt = idx
separator = vbtab
for fieldidx = 0 to rs.fields.count -1
linetxt = linetxt & separator & rs(fieldIdx)
next
returnVal = returnVal & vbcrlf & lineTxt
rs.movenext
Loop
printData = returnVal
end function
