Export Access data to an existing Excel Spreadsheet through VB 2

[jofarrell]

Is it possible to code in VB 6 a procedure that will take the data from either a recordset or an Access database and populate an existing Excel spreadsheet so that all an end user would have to do is take the "newly populated" spreadsheet and mail it to where it has to go? (Other people enter the data needed for this spreadsheet through my VB app)

Any suggestions are welcomed

Joanne

 

[bradmaunsell]

Yes.

(1) From Excel, create a connection to the database
(2) Create a recordset
(3) Setup a Do Until rs.EOF loop routine
(4) within the loop, use the EXCEL RANGE command to populate the cells

Here are some code clips that may help....


*********************************************************
This code connects to an SQL database from Excel

Dim rstConsultant As ADODB.Recordset
Dim strQuery As String
Dim strCnn As String
Dim dB_Connected As Integer

If dB_Connected = False Then
'strCnn = "Provider=SQLOLEDB;Server=AppServer;Trusted_Connection=No;UID=C2TTSREADONLY;PWD=idontcare;DATABASE=C2TTS"
'Rob
strCnn = "Provider=SQLOLEDB;Server=business01;Trusted_Connection=No;UID=C2TTSREADONLY;PWD=idontcare;DATABASE=C2TTS"
dB_Connected = True
End If
***********************************************************
This code populates a combo box - just change to set cell RANGE values
strQuery = "select name, username, AdminUserName from tblconsultants where ((tblconsultants.UserName = '" & strUserName & "') Or (tblconsultants.AdminUserName = '" & strUserName & "')) and name not like '%TBD%'"

Set rstConsultant = New ADODB.Recordset
rstConsultant.Open strQuery, strCnn, adOpenStatic, , adCmdText

If rstConsultant.BOF Then
MsgBox "UserName or AdminUserName login name was not found. You will have to select an employee name from the drop-down.", vbOKOnly, "login name"
Exit Sub ' no login name for this person - just keep going and let select from drop-down
Else
AutoStartupUserName = rstConsultant!Name
End If

rstConsultant.Close
End Sub



********************************************************

Hope this helps you

Brad

 

[JoaoTL]

Hi, hope it helps

Function sCopyRSExample(mon)
'Copy to first 20000 rows
'in an existing Excel Workbook and worksheet
'
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset

Dim intLastCol As Integer


Const conMAX_ROWS = 20000
Const conSHT_NAME = "YourSheet"
Const conWKB_NAME = "c:\Path\book1.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("Query" & mon,
dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2&quot.CopyFromRecordset rs
End With
End With
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Function

Regards
JoaoTL

 

[jofarrell]

Thank you very much for your responses I will see if I can get it to work

Joanne