Friday, April 24, 2015

Consolidating excel worksheets by VB Script

'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

No comments:

Post a Comment

Applying SMA10/20, SMA20/50 as trading signals

This is the comparison for results before and after applying SMA10/20 and SMA20/50 in the stock trader. Background Trading 3 stock ma...