Export to Mutiple Spreadsheets

[icq_giggles]

I've tried to use Ken's code, it worked fine then suddenly stopped. I've
been tweaking it so there could be compound problems by now.

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.

ANY Help is appreicated - THANKS!

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

 

[Steve Sanford]

There is a response in the Programming (modulesdaovba) forum.


FYI

Under TIPS for POSTING:

(http://www.microsoft.com/library/gallery/components/wn/3/locales/help/help_en-US.htm#PostToDG)

Don’t cross-post (add a single post to more than one discussion group at the
same time) or multi-post (add the same post to more than one discussion
group, one discussion group at a time). It is very unlikely that any post
really belongs in more than one or two discussion groups, and it is easier to
track responses to a single post. Take the time to choose the best single
discussion group for your post.


HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)

I've tried to use Ken's code, it worked fine then suddenly stopped. I've
been tweaking it so there could be compound problems by now.

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.

ANY Help is appreicated - THANKS!

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