VB creating an Excel spreadsheet file programmatically

Post #34,001 by lincoln 4/1/02 12:37:30 PM Reply	VB creating an Excel spreadsheet file programmatically Requesting help from anyone who knows how to do this. Been given an assignment to pull data (lots of it) from Access and SQL Server, to be parceled out into spreadsheet files and used by non-technical people. We used to query the data via SQL statements, then copy and paste from the Query Analyzer Results pane into text files, which we'd then import into Excel for these folks to use. Naturally that was labor intensive and a waste of time for one or more programmers. I'm trying to write something that can run overnight without intervention. But... I can't find the trick in MSDN on how VB can create an Excel spreadsheet file, and then use it to receive the output data. And I don't want to create dozens and dozens, if not hundreds, of spreadsheet files just laying around, waiting to be used on an irregular cycle. Any and all help will be appreciated. lincoln "Four score and seven years ago, I had a better sig"
Post #34,005 by ChrisR 4/1/02 12:51:58 PM Reply	VBScript Did it VBScript not too long ago. The VB should be approximately the same. This code opens an input excel file and writes to an output excel file. You can create the excel output file from scratch byt changing the xlbook - some method of Workbooks will allocate a new workbook - but I leave that as an exercise for the reader: ' set up the excel file Set xlapp = CreateObject("Excel.Application") Set xlbook = xlapp.Workbooks.Open(Server.MapPath("myexcelinfile.xls")) Set xlsheet = xlbook.Worksheets("RawData") xlapp.DisplayAlerts = False -- column headers in row 1 xlsheet.Cells(1, 1).Value = "My Column 1" xlsheet.Cells(1, 2).Value = "My Column 2" -- write out the data starting at row 2 xlsheet.Cells(2, 1).Value = 1.0 xlsheet.Cells(2, 2).Value = 2.0 ' finish up the excel processing xlbook.SaveAs Server.MapPath("myexceloutfile.xls") xlbook.Close xlapp.Quit Set xlsheet = Nothing Set xlbook = Nothing Set xlapp = Nothing
Post #34,036 by SpiceWare 4/1/02 3:32:21 PM 4/1/02 3:40:33 PM Reply	We do this all the time, here's a demo I just threw together One major trick I learned was use COPY and PASTE to add data to the Excel document. I don't know why, but it is significantly faster. Columns must be preformatted for cut/paste to work properly(or you'll get weird results on text data that looks like dates or numbers). The only downside is you cannot run multiple "Excel report" programs(or use cut/paste elsewhere) while the Excel document is being populated. Another trick - to figure out how to do something just record a macro in Excel, do whatever you wish to do, and then view the macro to see how to program it. The only tricky part is figuring out of the code goes after mxlApp. mxlWB. or mxlSheet. The following code does work(just tested it), though it's incomplete in that I didn't include the init for gProd_CN(the connection to Oracle). Not sure why <pre> is doublespacing everything. Tried a few things to stop it, but gave up. Option Explicit 'Global variables Private mxlApp As Excel.Application Private mxlWB As Excel.Workbook Private mxlSheet As Excel.Worksheet Private mxlRow As Long Public Sub ExcelReport() Call InitExcel Call ProcessData Call WrapUp End Sub Private Sub InitExcel() Set mxlApp = New Excel.Application Set mxlWB = mxlApp.Workbooks.Add() Set mxlSheet = mxlWB.Worksheets.Item(1) ' set TRUE to watch it work while debugging ' set FALSE for when user runs, else typing can cause program to crash mxlApp.Visible = True mxlSheet.Columns(1).NumberFormat = "@" ' TEXT data mxlSheet.Columns(2).NumberFormat = "#,##0_);[Red](#,##0)" ' NUMERIC data mxlSheet.Columns(3).NumberFormat = "mm/dd/yyyy" ' DATE Clipboard.Clear Clipboard.SetText ("ITEM" & vbTab & "QTY" & vbTab & "Date") mxlSheet.Cells(1, 1).Activate mxlSheet.Paste ' the 3 cells just pasted are "selected" making it convient ' to adjust the look at this moment mxlApp.Selection.Font.Bold = True mxlApp.Selection.Font.Color = vbBlue mxlRow = 2 End Sub Private Sub ProcessData() Dim RS As New ADODB.Recordset Dim SQL As String Dim text As String SQL = "" SQL = SQL & "select item," SQL = SQL & " rt_sub_item.on_hand('1','M1',item,revision) oh," SQL = SQL & " rt_sub_so.item_last_shipment_date(item,revision) last_shipped" SQL = SQL & " From item_ccn" SQL = SQL & " where make = 'Y'" SQL = SQL & " and item like '0010%'" SQL = SQL & " and rownum < 100" RS.Open SQL, gProd_CN Do While Not RS.EOF text = RS("ITEM") text = text & vbTab & RS("OH") text = text & vbTab & RS("last_shipped") Clipboard.Clear Clipboard.SetText (text) mxlSheet.Cells(mxlRow, 1).Activate mxlSheet.Paste With mxlApp.Selection ' put gridlines around data .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeLeft).Weight = xlThin .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = xlThin .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeTop).Weight = xlThin .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlThin .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideVertical).Weight = xlThin End With mxlRow = mxlRow + 1 RS.MoveNext Loop RS.Close End Sub Private Sub WrapUp() Dim i As Integer ' fit columns to data For i = 1 To 3 mxlSheet.Columns(i).EntireColumn.AutoFit Next i ' set first cell active, else you'll be at the bottom of the sheet mxlSheet.Cells(1, 1).Activate ' show spreadsheet, not needed if you're going to save file and quit mxlApp.Visible = True ' uncomment this to save file & quit Excel ' mxlWB.SaveAs "c:\\testfile.xls" ' mxlWB.Close ' mxlApp.Quit End Sub Darrell Spice, Jr. [link\|http://home.houston.rr.com/spiceware/\|SpiceWare] - We don't do Windows, it's too much of a chore Edited by SpiceWare April 1, 2002, 03:40:33 PM EST Expand All History
Post #34,041 by ChrisR 4/1/02 4:15:52 PM Reply	Double spacing The carriage returns within the pre tags are converted to two line break tags. If you want to get rid of the double spacing, you'll have to replace all the instances of CR/LF with break tags (<BR>)
Post #34,042 by SpiceWare 4/1/02 4:19:50 PM Reply	I see Doesn't Linux use just a line feed? If so, could I edit the post from home to make it look correct? Darrell Spice, Jr. [link\|http://home.houston.rr.com/spiceware/\|SpiceWare] - We don't do Windows, it's too much of a chore
Post #34,050 by ChrisR 4/1/02 5:05:33 PM Reply	Easiest way ...is to just use text replacement substituting \\n for <BR>. Though it seems that the software replaces <BR><BR> with a single <BR>. To get the full effect, you'd need to substitute <BR><BR> with <BR>\\n. Lot of work to do, but this is a "feature" that somehow got imported from EZboard. :-) Option Explicit 'Global variables Private mxlApp As Excel.Application Private mxlWB As Excel.Workbook Private mxlSheet As Excel.Worksheet Private mxlRow As Long Public Sub ExcelReport() Call InitExcel Call ProcessData Call WrapUp End Sub Private Sub InitExcel() Set mxlApp = New Excel.Application Set mxlWB = mxlApp.Workbooks.Add() Set mxlSheet = mxlWB.Worksheets.Item(1) ' set TRUE to watch it work while debugging ' set FALSE for when user runs, else typing can cause program to crash mxlApp.Visible = True mxlSheet.Columns(1).NumberFormat = "@" ' TEXT data mxlSheet.Columns(2).NumberFormat = "#,##0_);[Red](#,##0)" ' NUMERIC data mxlSheet.Columns(3).NumberFormat = "mm/dd/yyyy" ' DATE Clipboard.Clear Clipboard.SetText ("ITEM" & vbTab & "QTY" & vbTab & "Date") mxlSheet.Cells(1, 1).Activate mxlSheet.Paste ' the 3 cells just pasted are "selected" making it convient ' to adjust the look at this moment mxlApp.Selection.Font.Bold = True mxlApp.Selection.Font.Color = vbBlue mxlRow = 2 End Sub Private Sub ProcessData() Dim RS As New ADODB.Recordset Dim SQL As String Dim text As String SQL = "" SQL = SQL & "select item," SQL = SQL & " rt_sub_item.on_hand('1','M1',item,revision) oh," SQL = SQL & " rt_sub_so.item_last_shipment_date(item,revision) last_shipped" SQL = SQL & " From item_ccn" SQL = SQL & " where make = 'Y'" SQL = SQL & " and item like '0010%'" SQL = SQL & " and rownum < 100" RS.Open SQL, gProd_CN Do While Not RS.EOF text = RS("ITEM") text = text & vbTab & RS("OH") text = text & vbTab & RS("last_shipped") Clipboard.Clear Clipboard.SetText (text) mxlSheet.Cells(mxlRow, 1).Activate mxlSheet.Paste With mxlApp.Selection ' put gridlines around data .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeLeft).Weight = xlThin .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = xlThin .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeTop).Weight = xlThin .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlThin .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideVertical).Weight = xlThin End With mxlRow = mxlRow + 1 RS.MoveNext Loop RS.Close End Sub Private Sub WrapUp() Dim i As Integer ' fit columns to data For i = 1 To 3 mxlSheet.Columns(i).EntireColumn.AutoFit Next i ' set first cell active, else you'll be at the bottom of the sheet mxlSheet.Cells(1, 1).Activate ' show spreadsheet, not needed if you're going to save file and quit mxlApp.Visible = True ' uncomment this to save file & quit Excel ' mxlWB.SaveAs "c:\\testfile.xls" ' mxlWB.Close ' mxlApp.Quit End Sub
Post #34,059 by lincoln 4/1/02 6:02:45 PM Reply	Thanks everyone - I've got it working now (nomsg) lincoln "Four score and seven years ago, I had a better sig"

Welcome to IWETHEY!