Extract Access records to new workbook using VBA in Excel

[Sue]

Hi there

I am trying to work out the code to get records stored in Access (but
accessed via an Excel Interface) to open up in a new Excel workbook on
clicking a button (an 'export' or 'extract' function if you like) -
both 2003 versions...

I have successfully gotten them to open up into a new form (Excel
VBA), just can't get this right...(so haven't bothered putting my
sorry excuse for an attempt below, just the SQL stuff that sits behind
the combo boxes and then the code that opens it up in a new form etc)

Note: I do not want to create a query in Access and have Excel tap
into that. I have written an SQL in the Excel form - much
smoother...simply using the Access DB as a storage can..

Really appreciate some [any!] help here...have looked at other
people's spiels and the KB to no avail!

thanks in advance..
Sue



'In a seperate module, along with other public variables I have:

Sub FindDatabasePath()

path1 = "\\xxx\xxx\xxx\xxx\xxx\xxx\xxxx"
path1 = "" & path1 & "" & "\xxx\xxx\xxx\xxx\xxx\xxx\Xxxx.mdb"

End Sub

'(clearly, x reflects the specifics of the path to be found)

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

'In the form itself I have:

Option Explicit
Dim ws As Workspace
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim BHDrop() As Variant
Dim ProgrammeDrop() As Variant
Dim SQL1 As String
Dim rscount As Integer
Dim rscount1 As Integer
Dim gg As Integer
Dim zz As Integer

Private Sub UserForm_Initialize()
Set ws = DBEngine.Workspaces(0)
Call FindDatabasePath
Set db = ws.OpenDatabase(path1)

'open up a dataset

Set rs2 = db.OpenRecordset("SELECT tblProject.[BusinessHead] FROM
tblProject WHERE Not [Phase] = 'cancelled'" _
& " AND Not [Phase] = 'Completed' AND Not [Phase] = 'Delivered' AND
Not [Phase] = 'Value Captured'" _
& " GROUP BY tblProject.[BusinessHead]")

rscount1 = rs2.RecordCount - 1
rs2.MoveFirst

ReDim BHDrop(0 To rscount1, 1)

For zz = 0 To rscount1
BHDrop(zz, 0) = rs2.Fields(0)
rs2.MoveNext
Next zz
cmboxBH.List = BHDrop
cmboxBH.Value = Empty
cmboxAName.Value = Empty
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text

End Sub

Private Sub cmboxBH_Change()
cmboxAName.Value = ""
BusinessHeadID = cmboxBH.Text

If BusinessHeadID = "" Then
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]Is
Null"
Else
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]='" &
BusinessHeadID & "'"

End If

Set rs1 = db.OpenRecordset(SQL1)

If rs1.EOF Then
Else

rs1.MoveLast
rscount = rs1.RecordCount - 1
rs1.MoveFirst
ReDim ProgrammeDrop(0 To rscount, 1)
For gg = 0 To rscount
ProgrammeDrop(gg, 0) = rs1.Fields(0)
rs1.MoveNext
Next gg
cmboxAName.List = ProgrammeDrop
End If

End Sub

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

'To open the records in an Excel form (Input form), I have then
written:

Private Sub cmbInputform_Click()

MsgBox ("Compulsory fields in input forms" & Chr(13) & _
"are highlighted in Blue"), vbInformation, "PLEASE NOTE:"

Unload frmMainMenu
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text
AddNewRcrd = False
Completed = False
Call Closeout
With frmInput
..Show
End With
End Sub

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

Sub Closeout()

Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub

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

These all work fine...just need to know how to get it to extract the
records into a new workbook rather than a form...

ta.

 

[Tim Zych]

From what I understand, you can use Excel's built in CopyFromRecordset
method.

Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Workbooks.Add(1)
Set wks = wkb.Worksheets(1)
wks.Range("A1").CopyFromRecordset rs2


--
Tim Zych
SF, CA

Hi there

I am trying to work out the code to get records stored in Access (but
accessed via an Excel Interface) to open up in a new Excel workbook on
clicking a button (an 'export' or 'extract' function if you like) -
both 2003 versions...

I have successfully gotten them to open up into a new form (Excel
VBA), just can't get this right...(so haven't bothered putting my
sorry excuse for an attempt below, just the SQL stuff that sits behind
the combo boxes and then the code that opens it up in a new form etc)

Note: I do not want to create a query in Access and have Excel tap
into that. I have written an SQL in the Excel form - much
smoother...simply using the Access DB as a storage can..

Really appreciate some [any!] help here...have looked at other
people's spiels and the KB to no avail!

thanks in advance..
Sue



'In a seperate module, along with other public variables I have:

Sub FindDatabasePath()

path1 = "\\xxx\xxx\xxx\xxx\xxx\xxx\xxxx"
path1 = "" & path1 & "" & "\xxx\xxx\xxx\xxx\xxx\xxx\Xxxx.mdb"

End Sub

'(clearly, x reflects the specifics of the path to be found)

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

'In the form itself I have:

Option Explicit
Dim ws As Workspace
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim BHDrop() As Variant
Dim ProgrammeDrop() As Variant
Dim SQL1 As String
Dim rscount As Integer
Dim rscount1 As Integer
Dim gg As Integer
Dim zz As Integer

Private Sub UserForm_Initialize()
Set ws = DBEngine.Workspaces(0)
Call FindDatabasePath
Set db = ws.OpenDatabase(path1)

'open up a dataset

Set rs2 = db.OpenRecordset("SELECT tblProject.[BusinessHead] FROM
tblProject WHERE Not [Phase] = 'cancelled'" _
& " AND Not [Phase] = 'Completed' AND Not [Phase] = 'Delivered' AND
Not [Phase] = 'Value Captured'" _
& " GROUP BY tblProject.[BusinessHead]")

rscount1 = rs2.RecordCount - 1
rs2.MoveFirst

ReDim BHDrop(0 To rscount1, 1)

For zz = 0 To rscount1
BHDrop(zz, 0) = rs2.Fields(0)
rs2.MoveNext
Next zz
cmboxBH.List = BHDrop
cmboxBH.Value = Empty
cmboxAName.Value = Empty
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text

End Sub

Private Sub cmboxBH_Change()
cmboxAName.Value = ""
BusinessHeadID = cmboxBH.Text

If BusinessHeadID = "" Then
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]Is
Null"
Else
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]='" &
BusinessHeadID & "'"

End If

Set rs1 = db.OpenRecordset(SQL1)

If rs1.EOF Then
Else

rs1.MoveLast
rscount = rs1.RecordCount - 1
rs1.MoveFirst
ReDim ProgrammeDrop(0 To rscount, 1)
For gg = 0 To rscount
ProgrammeDrop(gg, 0) = rs1.Fields(0)
rs1.MoveNext
Next gg
cmboxAName.List = ProgrammeDrop
End If

End Sub

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

'To open the records in an Excel form (Input form), I have then
written:

Private Sub cmbInputform_Click()

MsgBox ("Compulsory fields in input forms" & Chr(13) & _
"are highlighted in Blue"), vbInformation, "PLEASE NOTE:"

Unload frmMainMenu
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text
AddNewRcrd = False
Completed = False
Call Closeout
With frmInput
.Show
End With
End Sub

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

Sub Closeout()

Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub

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

These all work fine...just need to know how to get it to extract the
records into a new workbook rather than a form...

ta.

 

[Mark Ivey]

Here are some examples...

DAO

http://www.exceltip.com/st/Import_d...l_(DAO)_using_VBA_in_Microsoft_Excel/428.html

http://www.ozgrid.com/forum/showthread.php?t=28221

http://puremis.net/excel/code/071.shtml




ADO

http://support.microsoft.com/kb/247412

http://support.microsoft.com/kb/257819

Hi there

I am trying to work out the code to get records stored in Access (but
accessed via an Excel Interface) to open up in a new Excel workbook on
clicking a button (an 'export' or 'extract' function if you like) -
both 2003 versions...

I have successfully gotten them to open up into a new form (Excel
VBA), just can't get this right...(so haven't bothered putting my
sorry excuse for an attempt below, just the SQL stuff that sits behind
the combo boxes and then the code that opens it up in a new form etc)

Note: I do not want to create a query in Access and have Excel tap
into that. I have written an SQL in the Excel form - much
smoother...simply using the Access DB as a storage can..

Really appreciate some [any!] help here...have looked at other
people's spiels and the KB to no avail!

thanks in advance..
Sue



'In a seperate module, along with other public variables I have:

Sub FindDatabasePath()

path1 = "\\xxx\xxx\xxx\xxx\xxx\xxx\xxxx"
path1 = "" & path1 & "" & "\xxx\xxx\xxx\xxx\xxx\xxx\Xxxx.mdb"

End Sub

'(clearly, x reflects the specifics of the path to be found)

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

'In the form itself I have:

Option Explicit
Dim ws As Workspace
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim BHDrop() As Variant
Dim ProgrammeDrop() As Variant
Dim SQL1 As String
Dim rscount As Integer
Dim rscount1 As Integer
Dim gg As Integer
Dim zz As Integer

Private Sub UserForm_Initialize()
Set ws = DBEngine.Workspaces(0)
Call FindDatabasePath
Set db = ws.OpenDatabase(path1)

'open up a dataset

Set rs2 = db.OpenRecordset("SELECT tblProject.[BusinessHead] FROM
tblProject WHERE Not [Phase] = 'cancelled'" _
& " AND Not [Phase] = 'Completed' AND Not [Phase] = 'Delivered' AND
Not [Phase] = 'Value Captured'" _
& " GROUP BY tblProject.[BusinessHead]")

rscount1 = rs2.RecordCount - 1
rs2.MoveFirst

ReDim BHDrop(0 To rscount1, 1)

For zz = 0 To rscount1
BHDrop(zz, 0) = rs2.Fields(0)
rs2.MoveNext
Next zz
cmboxBH.List = BHDrop
cmboxBH.Value = Empty
cmboxAName.Value = Empty
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text

End Sub

Private Sub cmboxBH_Change()
cmboxAName.Value = ""
BusinessHeadID = cmboxBH.Text

If BusinessHeadID = "" Then
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]Is
Null"
Else
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]='" &
BusinessHeadID & "'"

End If

Set rs1 = db.OpenRecordset(SQL1)

If rs1.EOF Then
Else

rs1.MoveLast
rscount = rs1.RecordCount - 1
rs1.MoveFirst
ReDim ProgrammeDrop(0 To rscount, 1)
For gg = 0 To rscount
ProgrammeDrop(gg, 0) = rs1.Fields(0)
rs1.MoveNext
Next gg
cmboxAName.List = ProgrammeDrop
End If

End Sub

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

'To open the records in an Excel form (Input form), I have then
written:

Private Sub cmbInputform_Click()

MsgBox ("Compulsory fields in input forms" & Chr(13) & _
"are highlighted in Blue"), vbInformation, "PLEASE NOTE:"

Unload frmMainMenu
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text
AddNewRcrd = False
Completed = False
Call Closeout
With frmInput
.Show
End With
End Sub

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

Sub Closeout()

Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub

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

These all work fine...just need to know how to get it to extract the
records into a new workbook rather than a form...

ta.

 

[Sue]

Here are some examples...

DAO

http://www.exceltip.com/st/Import_data_from_Access_to_Excel_(DAO)_usi...

http://www.ozgrid.com/forum/showthread.php?t=28221

http://puremis.net/excel/code/071.shtml

ADO

http://support.microsoft.com/kb/247412

http://support.microsoft.com/kb/257819

Hi there

I am trying to work out the code to get records stored in Access (but
accessed via an Excel Interface) to open up in a new Excel workbook on
clicking a button (an 'export' or 'extract' function if you like) -
both 2003 versions...

I have successfully gotten them to open up into a new form (Excel
VBA), just can't get this right...(so haven't bothered putting my
sorry excuse for an attempt below, just the SQL stuff that sits behind
the combo boxes and then the code that opens it up in a new form etc)

Note: I do not want to create a query in Access and have Excel tap
into that. I have written an SQL in the Excel form - much
smoother...simply using the Access DB as a storage can..

Really appreciate some [any!] help here...have looked at other
people's spiels and the KB to no avail!

thanks in advance..
Sue

'In a seperate module, along with other public variables I have:

Sub FindDatabasePath()

path1 = "\\xxx\xxx\xxx\xxx\xxx\xxx\xxxx"
path1 = "" & path1 & "" & "\xxx\xxx\xxx\xxx\xxx\xxx\Xxxx.mdb"

End Sub

'(clearly, x reflects the specifics of the path to be found)

'In the form itself I have:

Option Explicit
Dim ws As Workspace
Dim db As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim BHDrop() As Variant
Dim ProgrammeDrop() As Variant
Dim SQL1 As String
Dim rscount As Integer
Dim rscount1 As Integer
Dim gg As Integer
Dim zz As Integer

Private Sub UserForm_Initialize()
Set ws = DBEngine.Workspaces(0)
Call FindDatabasePath
Set db = ws.OpenDatabase(path1)

'open up a dataset

Set rs2 = db.OpenRecordset("SELECT tblProject.[BusinessHead] FROM
tblProject WHERE Not [Phase] = 'cancelled'" _
& " AND Not [Phase] = 'Completed' AND Not [Phase] = 'Delivered' AND
Not [Phase] = 'Value Captured'" _
& " GROUP BY tblProject.[BusinessHead]")

rscount1 = rs2.RecordCount - 1
rs2.MoveFirst

ReDim BHDrop(0 To rscount1, 1)

For zz = 0 To rscount1
BHDrop(zz, 0) = rs2.Fields(0)
rs2.MoveNext
Next zz
cmboxBH.List = BHDrop
cmboxBH.Value = Empty
cmboxAName.Value = Empty
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text

End Sub

Private Sub cmboxBH_Change()
cmboxAName.Value = ""
BusinessHeadID = cmboxBH.Text

If BusinessHeadID = "" Then
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]Is
Null"
Else
SQL1 = "SELECT [ProjectName],[BusinessHead] FROM tblProject WHERE Not
[Phase]= 'cancelled'" _
& " AND Not [Phase]= 'Completed' AND Not [Phase]= 'Delivered' AND Not
[Phase]= 'Value Captured'" _
& " GROUP BY [ProjectName], [BusinessHead] HAVING [BusinessHead]='" &
BusinessHeadID & "'"

End If

Set rs1 = db.OpenRecordset(SQL1)

If rs1.EOF Then
Else

   rs1.MoveLast
   rscount = rs1.RecordCount - 1
   rs1.MoveFirst
   ReDim ProgrammeDrop(0 To rscount, 1)
   For gg = 0 To rscount
   ProgrammeDrop(gg, 0) = rs1.Fields(0)
   rs1.MoveNext
   Next gg
   cmboxAName.List = ProgrammeDrop
End If

End Sub

'To open the records in an Excel form (Input form), I have then
written:

Private Sub cmbInputform_Click()

MsgBox ("Compulsory fields in input forms" & Chr(13) & _
"are highlighted in Blue"), vbInformation, "PLEASE NOTE:"

Unload frmMainMenu
ProjectID = cmboxAName.Text
BusinessHeadID = cmboxBH.Text
AddNewRcrd = False
Completed = False
Call Closeout
With frmInput
.Show
End With
End Sub

Sub Closeout()

Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub

These all work fine...just need to know how to get it to extract the
records into a new workbook rather than a form...

ta.- Hide quoted text -

- Show quoted text -

Hi Tim

Many thanks for that..

This is what I actually have at the moment, however I continue to get
a runtime error (5) when it hits this line:

wks.Range("A1").CopyFromRecordset rs2

"Invalid Procedure Call or Argument", and when I hover over it, rs2 =
nothing.. I'm missing something, just can't work out what..any ideas?

cheers, Sue

 

[Tim Zych]

It should go after the OpenRecordset command. Since there are 2 recordset
objects, maybe you are referring to the wrong one (?).

--
Tim Zych
SF, CA

Hi Tim

Many thanks for that..

This is what I actually have at the moment, however I continue to get
a runtime error (5) when it hits this line:

wks.Range("A1").CopyFromRecordset rs2

"Invalid Procedure Call or Argument", and when I hover over it, rs2 =
nothing.. I'm missing something, just can't work out what..any ideas?

cheers, Sue

 

[Sue]

It should go after the OpenRecordset command. Since there are 2 recordset
objects, maybe you are referring to the wrong one (?).

--
Tim Zych
SF, CA

Hi Tim

Many thanks for that..

This is what I actually have at the moment, however I continue to get
a runtime error (5) when it hits this line:

wks.Range("A1").CopyFromRecordset rs2

"Invalid Procedure Call or Argument", and when I hover over it, rs2 =
nothing.. I'm missing something, just can't work out what..any ideas?

cheers, Sue

Yeah, tried that.. no such luck unfortunately.
Hmmm...

S

 

[Tim Zych]

This approach works for me. Adjust the connection and command text to suit.
It needs a reference to the ADO library (ActiveX Data Objects 2.x).

Sub CopyFromRecordsetAdoTest()
'Set reference to ActiveX Data Objects 2.x Library
Dim rs As ADODB.Recordset
Dim conn As String
Dim strSql As String
Dim wkb As Workbook
Dim wks As Worksheet
conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=<Your_Database.mdb>;"
strSql = "<Your_Command_Text>;"
Set rs = New ADODB.Recordset
rs.Open strSql, conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
MsgBox "No records."
Else
Set wkb = Workbooks.Add(1)
Set wks = wkb.Worksheets(1)
wks.Range("A1").CopyFromRecordset rs
End If
If rs.State = adStateOpen Then
rs.Close
End If
Set rs = Nothing
Set wks = Nothing
Set wkb = Nothing
End Sub

--
Tim Zych
SF, CA

It should go after the OpenRecordset command. Since there are 2 recordset
objects, maybe you are referring to the wrong one (?).

--
Tim Zych
SF, CA

Hi Tim

Many thanks for that..

This is what I actually have at the moment, however I continue to get
a runtime error (5) when it hits this line:

wks.Range("A1").CopyFromRecordset rs2

"Invalid Procedure Call or Argument", and when I hover over it, rs2 =
nothing.. I'm missing something, just can't work out what..any ideas?

cheers, Sue

Yeah, tried that.. no such luck unfortunately.
Hmmm...

S