Ken Snell's Export to multiple Spreadsheets

I

icq_giggles

here's my adaptation, but (while it used to run) now I am getting a 3022
error - primary key type violation, not sure why or how - the break happens
at the qdf.Name = strDes
line. I'm sure it's something stupid I 've done or missed but been looking
at it too long to see. Please Help

Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String


Const strFileName As String = "ADPML_Vehicle"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV &
".xls"


' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName


' Get list of Designation values

strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of Designation values and create a query for each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
rstDes.MoveFirst
Do While rstDes.EOF = False


strDes = DLookup("[Designation]", "tblBOM", _
"[designation] = " & "'" & rstDes!designation.Value & "'")

strSQL = "SELECT * FROM qryADPML WHERE " & _
"[Designation] = '" & strDes & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strDes
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing






ds = rstDes!designation.Value
If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle
Assembly" Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
Else
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" & OBV
& ".xls"
End If
rstDes.MoveNext
Loop
End If

rstDes.Close
Set rstDes = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format


End Sub
Thank you,
 
A

aaron.kempf

learn a real ETL tool.. anyone using Access (Jet) for anything is like
a preschooler-- stuck and too scared to grow up into elementary school






here's my adaptation, but (while it used to run) now I am getting a 3022
error - primary key type violation, not sure why or how  - the break happens
at the qdf.Name = strDes
line.  I'm sure it's something stupid I 've done or missed but been looking
at it too long to see.  Please Help

Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String

Const strFileName As String = "ADPML_Vehicle"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
    "qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV &
".xls"

' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' Get list of Designation values

strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of Designation values and create a query for each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
      rstDes.MoveFirst
      Do While rstDes.EOF = False

            strDes = DLookup("[Designation]", "tblBOM", _
                  "[designation] = " & "'" & rstDes!designation.Value & "'")

            strSQL = "SELECT * FROM qryADPML WHERE " & _
                  "[Designation] = '" & strDes & "';"
            Set qdf = dbs.QueryDefs(strTemp)
            qdf.Name = strDes
            strTemp = qdf.Name
            qdf.SQL = strSQL
            qdf.Close
            Set qdf = Nothing

            ds = rstDes!designation.Value
            If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle  
Assembly" Then
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                  strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
            Else
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                  strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" & OBV
& ".xls"
            End If
            rstDes.MoveNext
      Loop
End If

rstDes.Close
Set rstDes = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format

End Sub
Thank you,
Click to expand...
 
I

icq_giggles

It's an adaptation of Ken Snell's code - here's the link to the original:

http://www.accessmvp.com/KDSnell/EXCEL_ImpExp.htm#FilterExportSameFile
--
Thank you,


Graham Mandeno said:
Hi icq_giggles

Why are you trying to change the name of zExportQuery???

--

Graham Mandeno [Access MVP]
Auckland, New Zealand

icq_giggles said:
here's my adaptation, but (while it used to run) now I am getting a 3022
error - primary key type violation, not sure why or how - the break
happens
at the qdf.Name = strDes
line. I'm sure it's something stupid I 've done or missed but been
looking
at it too long to see. Please Help

Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String


Const strFileName As String = "ADPML_Vehicle"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV &
".xls"


' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName


' Get list of Designation values

strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of Designation values and create a query for each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
rstDes.MoveFirst
Do While rstDes.EOF = False


strDes = DLookup("[Designation]", "tblBOM", _
"[designation] = " & "'" & rstDes!designation.Value &
"'")

strSQL = "SELECT * FROM qryADPML WHERE " & _
"[Designation] = '" & strDes & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strDes
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing






ds = rstDes!designation.Value
If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle
Assembly" Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
Else
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" &
OBV
& ".xls"
End If
rstDes.MoveNext
Loop
End If

rstDes.Close
Set rstDes = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format


End Sub
Thank you,
Click to expand...
Click to expand...
 
I

icq_giggles

Forgot to answer the question - you change the name of the query because when
you export to excel the tab name becomes the name of the query. If you don't
change it, it will simply overwrite the same tab over and over. Not give a
tab for each dataset.

Thank you,


Graham Mandeno said:
Hi icq_giggles

Why are you trying to change the name of zExportQuery???

--

Graham Mandeno [Access MVP]
Auckland, New Zealand

icq_giggles said:
here's my adaptation, but (while it used to run) now I am getting a 3022
error - primary key type violation, not sure why or how - the break
happens
at the qdf.Name = strDes
line. I'm sure it's something stupid I 've done or missed but been
looking
at it too long to see. Please Help

Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String


Const strFileName As String = "ADPML_Vehicle"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV &
".xls"


' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName


' Get list of Designation values

strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of Designation values and create a query for each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
rstDes.MoveFirst
Do While rstDes.EOF = False


strDes = DLookup("[Designation]", "tblBOM", _
"[designation] = " & "'" & rstDes!designation.Value &
"'")

strSQL = "SELECT * FROM qryADPML WHERE " & _
"[Designation] = '" & strDes & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strDes
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing






ds = rstDes!designation.Value
If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle
Assembly" Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
Else
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" &
OBV
& ".xls"
End If
rstDes.MoveNext
Loop
End If

rstDes.Close
Set rstDes = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format


End Sub
Thank you,
Click to expand...
Click to expand...
 
I

icq_giggles

Aaron,

I'll be sure to bring that up to management - they've listended to me so
well the last 900 times I've brought up our archaic data system. Perhaps I
should use your charming wit to dazzle them. Being so professional,
optimistic, and witty.
 
G

Graham Mandeno

Hello again

You will get error 3022 if you try to set the .Name of a QueryDef to the
same name as that of a query that already exists. My guess is that somehow
you have a query with the same name as one of the "Designation" values in
tblBOM.

It may be that a new designation has been added to the table that just
happens to match the existing query name, or it may be that this code has
terminated prematurely on a previous run and left the temporary query there
without deleting it. You don't appear to have any error handling code in
your procedure. You should always include code that handles possible errors
and then resumes at an exit point where things can be cleaned up, otherwise
you end up with files and recordsets left open, and temporary objects lying
about that might cause you problems later.

I have some code for exporting a recordset to Excel without using a saved
query or TransferSpreadsheet. Let me know if you are interested and I'll
dig it out and post it.

BTW, nice response to AK! :-D
--
Good Luck :)

Graham Mandeno [Access MVP]
Auckland, New Zealand

icq_giggles said:
Forgot to answer the question - you change the name of the query because
when
you export to excel the tab name becomes the name of the query. If you
don't
change it, it will simply overwrite the same tab over and over. Not give
a
tab for each dataset.

Thank you,


Graham Mandeno said:
Hi icq_giggles

Why are you trying to change the name of zExportQuery???

--

Graham Mandeno [Access MVP]
Auckland, New Zealand

icq_giggles said:
here's my adaptation, but (while it used to run) now I am getting a
3022
error - primary key type violation, not sure why or how - the break
happens
at the qdf.Name = strDes
line. I'm sure it's something stupid I 've done or missed but been
looking
at it too long to see. Please Help

Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String


Const strFileName As String = "ADPML_Vehicle"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV
&
".xls"


' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName


' Get list of Designation values

strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of Designation values and create a query for
each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
rstDes.MoveFirst
Do While rstDes.EOF = False


strDes = DLookup("[Designation]", "tblBOM", _
"[designation] = " & "'" & rstDes!designation.Value &
"'")

strSQL = "SELECT * FROM qryADPML WHERE " & _
"[Designation] = '" & strDes & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strDes
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing






ds = rstDes!designation.Value
If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle
Assembly" Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML
data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
Else
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" &
OBV
& ".xls"
End If
rstDes.MoveNext
Loop
End If

rstDes.Close
Set rstDes = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format


End Sub
Thank you,
Click to expand...
Click to expand...
Click to expand...
 
A

aaron.kempf

Maybe you should get certified-- on a practical database-- and get it
done and then ask for approval.

Most typical jet applications, I can upsize in less than week
_PART_TIME_.

-Aaron


Aaron,

I'll be sure to bring that up to management - they've listended to me so
well the last 900 times I've brought up our archaic data system.  Perhaps I
should use your charming wit to dazzle them.  Being so professional,
optimistic, and witty.

--
Thank you,

icq_giggles said:
here's my adaptation, but (while it used to run) now I am getting a 3022
error - primary key type violation, not sure why or how  - the break happens
at the qdf.Name = strDes
line.  I'm sure it's something stupid I 've done or missed but been looking
at it too long to see.  Please Help
Click to expand...
Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String
Click to expand...
Const strFileName As String = "ADPML_Vehicle"
Click to expand...
Const strQName As String = "zExportQuery"
Click to expand...
Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value
Click to expand...
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
    "qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV &
".xls"
Click to expand...
' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
Click to expand...
' Get list of Designation values
Click to expand...
strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
Click to expand...
' Now loop through list of Designation values and create a query for each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
      rstDes.MoveFirst
      Do While rstDes.EOF = False
Click to expand...
            strDes = DLookup("[Designation]", "tblBOM", _
                  "[designation] = " & "'" & rstDes!designation.Value & "'")
Click to expand...
            strSQL = "SELECT * FROM qryADPML WHERE " & _
                  "[Designation] = '" & strDes & "';"
            Set qdf = dbs.QueryDefs(strTemp)
            qdf.Name = strDes
            strTemp = qdf.Name
            qdf.SQL = strSQL
            qdf.Close
            Set qdf = Nothing
Click to expand...
            ds = rstDes!designation.Value
            If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle  
Assembly" Then
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                  strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
            Else
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                  strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" & OBV
& ".xls"
            End If
            rstDes.MoveNext
      Loop
End If
Click to expand...
rstDes.Close
Set rstDes = Nothing
Click to expand...
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format
Click to expand...
End Sub
Thank you,
Click to expand...
Click to expand...
 
K

Ken Snell _ MVP

icq_giggles --

I concur with Graham Mandeno's analysis of your error situation. The problem
is that you are not deleting the newly created query within the loop; you're
doing it after the loop is done. Move the deletion of the strTemp query
inside the loop (excerpt of the code below):

End If
dbs.QueryDefs.Delete strTemp ' newly added step
rstDes.MoveNext
Loop
--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


icq_giggles said:
here's my adaptation, but (while it used to run) now I am getting a 3022
error - primary key type violation, not sure why or how - the break
happens
at the qdf.Name = strDes
line. I'm sure it's something stupid I 've done or missed but been
looking
at it too long to see. Please Help

Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String


Const strFileName As String = "ADPML_Vehicle"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV &
".xls"


' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName


' Get list of Designation values

strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of Designation values and create a query for each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
rstDes.MoveFirst
Do While rstDes.EOF = False


strDes = DLookup("[Designation]", "tblBOM", _
"[designation] = " & "'" & rstDes!designation.Value &
"'")

strSQL = "SELECT * FROM qryADPML WHERE " & _
"[Designation] = '" & strDes & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strDes
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing






ds = rstDes!designation.Value
If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle
Assembly" Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
Else
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" &
OBV
& ".xls"
End If
rstDes.MoveNext
Loop
End If

rstDes.Close
Set rstDes = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format


End Sub
Thank you,
Click to expand...
 
K

Ken Snell

icq_giggles --

I concur with Graham Mandeno's analysis of your error situation. The problem
is that you are not deleting the newly created query within the loop; you're
doing it after the loop is done. Move the deletion of the strTemp query
inside the loop (excerpt of the code below):

End If
dbs.QueryDefs.Delete strTemp ' newly added step
rstDes.MoveNext
Loop
--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/


icq_giggles said:
here's my adaptation, but (while it used to run) now I am getting a 3022
error - primary key type violation, not sure why or how - the break
happens
at the qdf.Name = strDes
line. I'm sure it's something stupid I 've done or missed but been
looking
at it too long to see. Please Help

Public Sub PrelimExport()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstDes As DAO.Recordset
Dim strSQL As String, strTemp As String, strDes As String
Dim OBV As String
Dim ds As String


Const strFileName As String = "ADPML_Vehicle"

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb
OBV = [Forms]![frmBOMUpload]![txtOBV].Value

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"qryWhereUsed", "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" & OBV &
".xls"


' Create temporary query that will be used for exporting data;
'DoCmd.DeleteObject acQuery, "zExportQuery"
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName


' Get list of Designation values

strSQL = "SELECT DISTINCT tblBOM.Designation" & _
" FROM tblBOM" & _
" WHERE (((tblBOM.Vehicle)like'*" & OBV & "*'));"
Set rstDes = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of Designation values and create a query for each
Designation
' so that the data can be exported
If rstDes.EOF = False And rstDes.BOF = False Then
rstDes.MoveFirst
Do While rstDes.EOF = False


strDes = DLookup("[Designation]", "tblBOM", _
"[designation] = " & "'" & rstDes!designation.Value &
"'")

strSQL = "SELECT * FROM qryADPML WHERE " & _
"[Designation] = '" & strDes & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strDes
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing






ds = rstDes!designation.Value
If ds = "A Assembly" Or ds = "B Assembly" Or ds = "Vehicle
Assembly" Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Vehicle_" &
OBV & ".xls"
Else
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, _
strTemp, "H:\New ADPML data\TEST\Prelim_ADPML_Kits_" &
OBV
& ".xls"
End If
rstDes.MoveNext
Loop
End If

rstDes.Close
Set rstDes = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Call Format


End Sub
Thank you,
Click to expand...
 

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

Similar Threads

Ken Snell's Multiple sheet export 2
Export to Mutiple Spreadsheets 1
export vba not working 0
return without gosub error 0
return without gosub error 0
VBA Code Help 3
Export table to multiple excel worksheets` 7
Passing Parameter From Form mismatched criteria 10

Top