Wednesday, November 5, 2008

Read from Database, Write to a Excel File


<%
' I use this script to read data from database, then write data back to excel file

' Option Explicit
REM We use "Option Explicit" to help us check for coding mistakes
Dim MM_Connection1_STRING
Dim Conn_string
Dim conn
Dim RS

MM_Connection1_STRING = "DSN=Your_Data_Source_Name;UID=the_user_name;PWD=the_password;"
Conn_string = MM_Connection1_STRING

Set Conn=Server.CreateObject("ADODB.Connection")
Conn.Open Conn_string

REM the Excel Application
Dim objExcel
REM the path to the excel file
Dim excelPath
REM the WorkBooks
Dim objWorkBooks
REM how many worksheets are in the current excel file
Dim worksheetCount
Dim counter
REM the worksheet we are currently getting data from
Dim currentWorkSheet
REM the number of columns in the current worksheet that have data in them
Dim usedColumnsCount
REM the number of rows in the current worksheet that have data in them
Dim usedRowsCount
Dim row
Dim column
REM the topmost row in the current worksheet that has data in it
Dim top
REM the leftmost row in the current worksheet that has data in it
Dim left
Dim Cells
REM the current row and column of the current worksheet we are reading
Dim curCol
Dim curRow
REM the value of the current row and column of the current worksheet we are reading
Dim word

response.write "Writing Data from " & excelPath

REM where is the Excel file located?
excelPath = "D:\Sites\Danny_Testing\check_Exchange_Symbol\test.xls"

REM Create an invisible version of Excel
Set objExcel = CreateObject("Excel.Application")

REM don't display any messages about documents needing to be converted
REM from old Excel file formats
objExcel.DisplayAlerts = false

REM open the excel document as read-only
REM open (path, confirmconversions, readonly)
' objExcel.Workbooks.open excelPath, false, true
Set objWorkBooks = objExcel.Workbooks.open( excelPath, false, false )


REM How many worksheets are in this Excel documents
workSheetCount = objExcel.Worksheets.Count

response.write "We have " & workSheetCount & " worksheets

"

REM Loop through each worksheet
For counter = 1 to workSheetCount
response.write "-----------------------------------------------"
response.write "Writing data from worksheet " & counter & "

"

Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter)
REM how many columns are used in the current worksheet
usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count
REM how many rows are used in the current worksheet
usedRowsCount = currentWorkSheet.UsedRange.Rows.Count

REM What is the topmost row in the spreadsheet that has data in it
top = currentWorksheet.UsedRange.Row
REM What is the leftmost column in the spreadsheet that has data in it
left = currentWorksheet.UsedRange.Column

Set Cells = currentWorksheet.Cells

' REM Loop through each row in the worksheet
' For row = 0 to (usedRowsCount-1)
' REM only look at rows that are in the "used" range
' curRow = row + top
'
' REM Loop through each column in the worksheet
' REM Uncomment this loop block if you want to display the columns
' For column = 0 to usedColumnsCount-1 on the web page.
' REM only look at columns that are in the "used" range
' curCol = column+Left
'
' REM get the value/word that is in the cell
' word = Cells(curRow,curCol).Value
' REM display the column on the screen
'
' response.write "" & (word) & ""
' Next
'
' exchangeID = Cells(curRow,0+left).Value ' col 2 is exchange
' theSymbol = Cells(curRow,1+left).Value ' col 3 is symbol
'
' Cells(curRow,0+left).Value = "test" ' col 0 is for ID
' Cells(curRow,1+left).Value = "a string" ' col 1 is for Name
' Next

curRow = 1
tmpKEY = 0

set RS = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM members"
RS.open strSQL,Conn,3,3
While Not RS.EOF
Cells(curRow,0+left).Value = RS("MG_NUMBER_KEY") &""
Cells(curRow,1+left).Value = RS("company_name")
curRow = curRow + 1
RS.MoveNext
Wend

objWorkBooks.Save

'currentWorkSheet.SaveAs("D:\Sites\Danny_Testing\check_Exchange_Symbol\Test2.xls")

RS.close
Set RS = Nothing

REM We are done with the current worksheet, release the memory
Set currentWorkSheet = Nothing
Next

conn.close
Set conn = nothing

objExcel.Workbooks(1).Close
objExcel.Quit

Set currentWorkSheet = Nothing
REM We are done with the Excel object, release it from memory
Set objWorkBooks = nothing
Set objExcel = Nothing

%>

No comments: