Exporting from MSSQL to Excel in VB

S

Sara1969

Hi all.
I'm pretty new to VB.. but I've managed to take some existing code, slightly
modify it, and insert it into a project at work and successfully transfer a
recordset from MSSQL to Excel.
Now.. I'm trying to format the spreadsheet. To do this, I'll need some
static text headings. Can anyone tell me how the following code might be
manipulated to do this? Thx in advance!

The Code to call the sub:
--------------------------------------------------------------------------------
SQLStmt = "select top 20* from calendar"
RS.Open SQLStmt, Con, adOpenStatic
Rec2Excel SQLStmt, Con
RS.Close
--------------------------------------------------------------------------------

The Sub:
--------------------------------------------------------------------------------
Private Sub Rec2Excel(xRecordSet As String, Con As ADODB.Connection)

'This SubRoutine will Print the Data in any Recordset to Excel,
'be it a SQL statement or valid Recordset Table Name.

Dim I As Integer
Dim RS As ADODB.Recordset
Dim exc As Excel.Application

Set RS = New ADODB.Recordset
RS.Open xRecordSet, Con, adOpenStatic, adLockReadOnly
Set exc = CreateObject("Excel.Application")
exc.Workbooks.Add
exc.Visible = True

With exc

For I = 0 To RS.Fields.Count - 1
.Cells(1, I + 1) = RS(I).Name
Next

I = 1

While Not RS.EOF
I = I + 1

For j = 0 To RS.Fields.Count - 1

If RS(j).Type = adVarChar Or RS(j).Type = adChar Then
If IsNull(RS(j)) Then
.Cells(I, j + 1) = ""
Else
.Cells(I, j + 1) = Trim(RS(j))
End If

.Cells(I, j + 1).Borders.LineStyle = xlDouble
.Cells(I, j + 1).Borders.Color = vbBlue

ElseIf RS(j).Type = adDecimal Or RS(j).Type = adNumeric Or
RS(j).Type = adInteger Then
If IsNull(RS(j)) Then
.Cells(I, j + 1) = ""
Else
.Cells(I, j + 1) = Str(RS(j))
End If

.Cells(I, j + 1).Borders.LineStyle = xlDouble
.Cells(I, j + 1).Borders.Color = vbBlue

End If
Next

RS.MoveNext
Wend

.Range("A1:" & Chr(65 + j) & 1).Font.Bold = True
.Range("A1:" & Chr(65 + j) & 1).Font.Color = vbRed
.Range("A1:" & Chr(65 + j) & 1).Borders.LineStyle = xlDouble
'.Range("A1:" & Chr(65 + j) & 1).Borders
' .Color = vbRed
.Columns("$A:" & "$" & Chr(65 + j)).AutoFit
End With

Set RS = Nothing
End Sub

--------------------------------------------------------------------------------
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top