Run "Make Table" Query in Access from Excel VBA

Hi Forum,

can someone help me here?
Applications: Access 2002, Excel 2003.

I have been using the following method to get data from Access into Excel.
Set ShDest = Sheets("Tabelle2")

Dim MyDatabase As DAO.Database
Dim MyQueryDef As DAO.QueryDef
Dim MyRecordset As DAO.Recordset

'Step 2: Identify the database and query
Set MyDatabase = DBEngine.OpenDatabase _
("\\STATION\PasstProReloaded\Excel.mdb")
Set MyQueryDef = MyDatabase.QueryDefs("abfPasstPro_Excel_0")

'Step 3: Define the Parameters
With MyQueryDef
.Parameters("[CustNo]") = KdNr
End With

'Step 4: Open the query
Set MyRecordset = MyQueryDef.OpenRecordset

'clear existing data on the sheet
ShDest.Activate

Cells.Select
Selection.ClearContents
'create field headers
i = 0
With Range("A1")
For Each fld In MyRecordset.Fields
.Offset(0, i).Value = fld.Name
i = i + 1
Next fld
End With

'transfer data to Excel
Range("A2").CopyFromRecordset MyRecordset
--------------------------------------------------------

That works as it should but now I need to run a make table query from Excel and pass a parameter (KDNR) to it.
The method above does not work with this action query.
Here is the SQL from the Make Table Query in Access. How can I get Excel to run this?

strUmsatz = "SELECT dbo_STATISTIKVK.KUNDE, Sum(dbo_STATISTIKVK.WERTEK) AS WE_Gesamt, Sum(dbo_STATISTIKVK.WERTVK) AS Umsatz_Gesamt, ([Umsatz_Gesamt]-[WE_Gesamt])/[Umsatz_Gesamt] AS Spanne_PC_Gesamt, [Umsatz_Gesamt]-[WE_Gesamt] AS Spanne_EUR_Gesamt, Year([BELEGDAT]) AS Year_, dbo_STATISTIKVK.ARTIKEL INTO tbl_Excel_Umsatz " & _
"FROM dbo_STATISTIKVK " & _
"WHERE (((dbo_STATISTIKVK.MENGE)>0) AND ((dbo_STATISTIKVK.BELEGDAT)>#1/1/2010#)) " & _
"GROUP BY dbo_STATISTIKVK.KUNDE, Year([BELEGDAT]), dbo_STATISTIKVK.ARTIKEL " & _
"HAVING (((dbo_STATISTIKVK.KUNDE)=" & KDNR & ") AND ((Sum(dbo_STATISTIKVK.WERTVK))>0) AND ((dbo_STATISTIKVK.ARTIKEL)<>""VERSAND"" And (dbo_STATISTIKVK.ARTIKEL)<>""99"" And (dbo_STATISTIKVK.ARTIKEL)<>""MAN"" And (dbo_STATISTIKVK.ARTIKEL)<>""Manuell"")) " & _
"ORDER BY Year([BELEGDAT]);"

Thanks for your time and consideration

Nick

I have looked around a bit and found what I believe could be the solution but this is not working :-(
I have never used this method and really don't know where I am going wrong, the SQL works fine in Access.
Could someone please have a look at it and point me in the right direction?

Dim cmd As New ADODB.Command
Dim conn As ADODB.Connection
Dim prm As ADODB.Parameter
Dim strConn As String
Set cmd = New ADODB.Command

cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandText = "CREATE PROCEDURE procUmsatz " & _
"(CustNo long) " & _
"AS SELECT dbo_STATISTIKVK.KUNDE, Sum(dbo_STATISTIKVK.WERTEK) AS WE_Gesamt, Sum(dbo_STATISTIKVK.WERTVK) AS Umsatz_Gesamt, ([Umsatz_Gesamt]-[WE_Gesamt])/[Umsatz_Gesamt] AS Spanne_PC_Gesamt, [Umsatz_Gesamt]-[WE_Gesamt] AS Spanne_EUR_Gesamt, Year([BELEGDAT]) AS Year_, dbo_STATISTIKVK.ARTIKEL INTO tbl_Excel_Umsatz " & _
"FROM dbo_STATISTIKVK " & _
"WHERE (((dbo_STATISTIKVK.MENGE)>0) AND ((dbo_STATISTIKVK.BELEGDAT)>#1/1/2010#)) " & _
"GROUP BY dbo_STATISTIKVK.KUNDE, Year([BELEGDAT]), dbo_STATISTIKVK.ARTIKEL " & _
"HAVING (((dbo_STATISTIKVK.KUNDE)= [CustNo]) AND ((Sum(dbo_STATISTIKVK.WERTVK))>0) AND ((dbo_STATISTIKVK.ARTIKEL)<>""VERSAND"" And (dbo_STATISTIKVK.ARTIKEL)<>""99"" And (dbo_STATISTIKVK.ARTIKEL)<>""MAN"" And (dbo_STATISTIKVK.ARTIKEL)<>""Manuell"")) " & _
"ORDER BY Year([BELEGDAT])"
cmd.Execute

'--------------------------------------------------------------------------

strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=\\STATION\PasstProReloaded\Excel.mdb"

Set conn = New ADODB.Connection
conn.Open strConn

Set cmd = New ADODB.Command
cmd.CommandText = "procUmsatz"
cmd.CommandType = adCmdStoredProc
cmd.ActiveConnection = conn

Set prm = cmd.CreateParameter("CustNo", adInteger, adParamInput)
cmd.Parameters.Append prm
cmd.Parameters("CustNo").Value = KdNr

'Execute the Stored Procedure
cmd.Execute

'Close the connection
conn.Close

Test Reply

I am having a problem posting a sub routine. Will send parts of the routine in
several replies.

The purpose here:
Use DAO instead of ADO
Create and Run Make Table Query
Create and Run DAO Param Query
Have all the code run from EXCEL MODULE
The code is tested and works.
It was tested in Excel 2007 against an MDB file.
The dummy table is called EmpRev and has two NUMBER
fields called EmpNo and Revenue
The MDB file is called RankValues.MDB
Create MDB and Table and add 2 records
As PROOF OF CONCEPT it would be easier to create the MDB and table just described.

End Of Part One

Public Sub SQL_Illustrate_DAO_MakeTableQuery_ExcelToAccess()

    On Error GoTo EH_SQL_Illustrate_DAO_MakeTableQuery_ExcelToAccess

    '-----------------
    '   Put in Excel Module
    '-----------------

    '-----------------
    '  Forum Question
    '-----------------
    'http://www.excelforum.com/access-tables-and-databases/831057-run-make-table-query-in-access-from-excel-vba.html
    
    '-----------------
    '   ADO
    '-----------------
    '   Tools --> References --> Add items below
    '-----------------
    '   NOT USED IN THIS ROUTINE
    '-----------------
    ' * Save work book as Macro Workbook
    ' * Add General Module Alt-F11 - Insert Module
    ' * Tools -> References -> Microsoft ActiveX Data Objects 2.8
    ' * Tools -> References -> Microsoft ActiveX Data Recordset 2.8 Library
    ' * Tools -> References -> Microsoft ADO Ext 2.8 for DDL and Security
    
    '----------------------------
    '   DAO - for Access 2007 Only
    '----------------------------
    ' * Tools -> References -> Microsoft Office 12.0 Access Database engine Object Library
    ' * DO **** NOT **** USE ----> DAO Ext 3.6
    '----------------------------
    
    '----------------------------
    '   Objects
    '----------------------------
    Dim MyDB As DAO.Database
    Dim MyQDF As DAO.QueryDef
    Dim MyNewQDF As DAO.QueryDef
    Dim MyTblDef As DAO.TableDef
    Dim MyTblDefs As DAO.TableDefs
    Dim MyRecordSet As DAO.Recordset
    
    '----------------------------
    '   Database Related
    '----------------------------
    Dim MyDBPath As String
    Dim MyDBFileName As String
    Dim MyDBFullFileName As String
    
    '----------------------------
    '   Table Names
    '----------------------------
    Dim My_SourceTable_Name As String
    Dim My_MakeTable_Name As String
    
    '----------------------------
    '   Parameter Query
    '----------------------------
    Dim PQ_Name As String
    Dim PQ_SQL As String
    Dim PQ_Clause As String
    Dim PQ_Query As String
    
    '----------------------------
    '   Misc
    '----------------------------
    Dim Tmp As String
    Dim DBExists As String
    Dim iObject As Integer
    Dim iVersion As Integer
    Dim iCase As Integer
    Dim lngRecCNT As Long
    Dim lngFldsCNT As Long
    Dim DeleteParamQryDef As Boolean
    Dim ExistsParamQryDef As Boolean

End of Part Two

    '-----------------
    '   Path
    '-----------------
    MyDBPath = ThisWorkbook.Path
    MyDBPath = MyDBPath & "\"
    
    '-----------------
    '   Determines Database File and Table Name
    '-----------------
    iVersion = 2003
    Select Case iVersion
        Case 2007
            MyDBFileName = "DBTarget.accdb"
            My_SourceTable_Name = "RefTable"
            My_MakeTable_Name = "RefTable_BackUp"
        Case 2003, 2002, 2000
            MyDBFileName = "RankValues.mdb"
            My_SourceTable_Name = "EmpRev"
            My_MakeTable_Name = "EmpRev_BackUp"
    End Select
    
    '-----------------
    '   Full DB Name
    '-----------------
    MyDBFullFileName = MyDBPath & MyDBFileName

    '-----------------
    '   DB Exists
    '-----------------
    DBExists = Dir(MyDBFullFileName, vbDirectory)
    If DBExists = vbNullString Then
        MsgBox "Invalid File Name " & MyDBFullFileName & " terminating", vbCritical, "Public Sub SQL_MakeTable()"
        Exit Sub
    End If

    '-----------------
    '   DAO Objects - Init
    '-----------------
    Set MyDB = Nothing
    Set MyQDF = Nothing
    Set MyTblDef = Nothing
    Set MyTblDefs = Nothing
    Set MyRecordSet = Nothing
    
    '-----------------
    '   Open Database
    '-----------------
    Set MyDB = OpenDatabase(MyDBFullFileName)

End of Part Three

    '*****************************************
    '*****************************************
    '
    '   Delete Previous My_MakeTable_Name
    '
    '*****************************************
    '*****************************************
    With MyDB
        For Each MyTblDef In .TableDefs
            If UCase(MyTblDef.Name) = UCase(My_MakeTable_Name) Then
                MyDB.Execute "Drop Table " & My_MakeTable_Name
                Exit For
            End If
        Next
    End With

    '-----------------
    '   WORKS
    '-----------------
    '   Make Table SQL
    '-----------------
    '   Replace SQL below with your own ** BUT **
    '   Run **your** SQL in Access first to PROVE that SQL has no syntax errors
    '-----------------
    Tmp = vbNullString
    Tmp = "SELECT "
    Tmp = Tmp & " * "
    Tmp = Tmp & "INTO  "
    Tmp = Tmp & My_MakeTable_Name
    Tmp = Tmp & " FROM  "
    Tmp = Tmp & My_SourceTable_Name

    '-----------------
    '   Both Methods WORK
    '-----------------
    iObject = 1
    Select Case iObject
        Case 1
            MyDB.Execute Tmp
        Case 2
            Set MyQDF = MyDB.CreateQueryDef("")
            With MyQDF
                .SQL = Tmp
                .Execute
                .Close
            End With
    End Select

End of Part Four

    '*****************************************
    '*****************************************
    '
    '   Create a PARAM QUERY (4 Steps)
    '
    '*****************************************
    '*****************************************
    
    '-----------------
    '   Param Query Name (1 of 4)
    '-----------------
    PQ_Name = "Get_EmpNo_Data"
    
    '-----------------
    '   Param Query SQL  (2 of 4)
    '-----------------
    PQ_SQL = vbNullString
    PQ_SQL = "SELECT "
    PQ_SQL = PQ_SQL & " * "
    PQ_SQL = PQ_SQL & "FROM "
    PQ_SQL = PQ_SQL & My_MakeTable_Name
    PQ_SQL = PQ_SQL & " WHERE  "
    PQ_SQL = PQ_SQL & " EmpNo  "
    PQ_SQL = PQ_SQL & " =  "
    PQ_SQL = PQ_SQL & " [EmpNum] "
    
    '-----------------
    '   Param Query CLAUSE (3 of 4)
    '-----------------
    PQ_Clause = "PARAMETERS [EmpNum] NUMBER;"
    
    '-----------------
    '   Complete Param Query (4 of 4)
    '-----------------
    PQ_Query = PQ_Clause & PQ_SQL
    
    '*****************************************
    '*****************************************
    '
    '   Does the Param Query Already Exist?
    '
    '*****************************************
    '*****************************************
    ExistsParamQryDef = False
    With MyDB
        For Each MyQDF In .QueryDefs
            If UCase(MyQDF.Name) = UCase(PQ_Name) Then
                ExistsParamQryDef = True
                Exit For
            End If
        Next
    End With
    
    '-----------------
    '   If the Query Already Exists - Do you want to DELETE IT
    '-----------------
    If ExistsParamQryDef Then
        iCase = 1
        Select Case iCase
        Case 1
            DeleteParamQryDef = False
        Case 2
            DeleteParamQryDef = True
        End Select
    End If
    
    '-----------------
    '   Delete Param Query
    '-----------------
    If ExistsParamQryDef And DeleteParamQryDef Then
        With MyDB
            '-----------------
            '   Delete PQ_Name
            '-----------------
            .QueryDefs.Delete (PQ_Name)
            '-----------------
            '   Add PQ_Name
            '-----------------
            Set MyNewQDF = .CreateQueryDef(PQ_Name, PQ_Query)
        End With
    Else
        With MyDB
            Set MyNewQDF = .QueryDefs(PQ_Name)
        End With
    End If
    
    '-----------------
    '   Run PQ_Name
    '-----------------
    With MyDB
        MyNewQDF.Parameters("EmpNum") = 1
        Set MyRecordSet = MyNewQDF.OpenRecordset
        With MyRecordSet
            .MoveLast
            .MoveFirst
            lngRecCNT = .RecordCount
            lngFldsCNT = .Fields.Count
        End With
    End With
    
    '-----------------
    '   Close DB
    '-----------------
    MyDB.Close

    '-----------------
    '-----------------
    Exit Sub

EH_SQL_Illustrate_DAO_MakeTableQuery_ExcelToAccess:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "SQL_Illustrate_DAO_MakeTableQuery_ExcelToAccess()"
    Exit Sub

End Sub

End of Part Five