I feel like one of the blind men trying to describe an elephant.
I‘ve taken great bits of code (some from this site) to get pieces of what I need, but I’ve created a monster instead of an elephant.
The code needs to do ALL of the following:
1) Export memo fields that are greater than 255 characters (acExport will do that)
2) Loop thru the code to create a workbook (.xls) for each Area in a table
(This is based on a field in the database. (QueryDef does it)
3) The folder name is not the Area, but an abbreviation taken from tlbAreas. (DLookup)
4) The query is passed the Area – not the Abbreviation (qdfParmQry does it)
5) I would like to get a row count for each Area so I don’t have to open each workbook after it is created
(The count is entered into our production log.)
Currently I am running two queries – one to get the xls and one to get a row count. Ouch!
6) I would like the “export” code to be in a Query (e.g., 99-StdCandIExtract) not hard coded in the module.
(Then it can be used and maintained in the database - not in the module.)
7) One minor irritation – This code does a clean up at the end, but if this aborts I have to manually clean up the QueryDefs’ Z-queries or it dies.. How to fix this?
Here is the code using Access 2003 (minus some of the comments and debug bits)
Can it be simplified? (It is really ugly and is difficult to maintain. I'm still struggling with VBA)
Can it export (with >255 characters in memo fields) and count rows using one query? (I’ve looked but can’t find an acExport parm.)
Appreciate any help you can provide.
Sub CaseAndInv4Areas()
' This module will run a SQL query and drop it in the appropriate Service Area folder
' The Service Area name and abbreviation are in tblAreas (or tblAreasTest)
' The abbreviation indicates the folder name.
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rsArea As DAO.Recordset
Dim qdfParmQry As QueryDef 'the actual query object
Dim rsValDate As DAO.Recordset
Dim strSQL As String, strSQLRowCnt As String, strTemp As String, strArea As String, strAreaAbbrev As String, strValDate As String
Dim dtToDate As Date
Dim strTable As String
'Dim strMsg As String
'strTable = "tblAreas" ' for production
strTable = "tblAreasTest" ' for testing
Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
' get ValDate into strValDate - will be used as part of filename
strValDate = DLookup("[Valuation Date]", "Valuation")
' Create temporary query that will be used for exporting data;
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
' *** code to set strSQL
' Get list of Area values --
strSQL = "select DISTINCT Area FROM " & strTable & ";"
Set rsArea = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
Debug.Print "Start: "; Now()
' Now loop through list of Area values and create a query for each Area
' so that the data can be exported
If rsArea.EOF = False And rsArea.BOF = False Then
rsArea.MoveFirst
Do While rsArea.EOF = False
' pick up Folder name
strAreaAbbrev = DLookup("AreaAbbrev", strTable, "Area = '" & rsArea!Area.Value & "'")
' pick up Area for sql Where clause
strArea = rsArea!Area.Value
' *** code to set strSQL
Dim rsCount As Integer
Dim queryNameOrSQL As String
‘ this section uses a Query to get Row Count
Set qdfParmQry = dbs.QueryDefs("99-StdCandIExtract")
'qdfParmQry![Enter Service Area] = strArea
' or try this one
qdfParmQry("Enter Service Area") = strArea
Set rs = qdfParmQry.OpenRecordset()
rs.MoveLast
rsCount = rs.RecordCount
Debug.Print strArea & " .xls will have " & rsCount & " rows"
‘ simplified query for testing - wish this was a Query instead of hard-coded
strSQL = "select cases.case_no, investigations.inv_no " & _
"FROM Cases LEFT JOIN Investigations ON Cases.Case_No = Investigations.Case_No " & _
"WHERE " & _
"Cases.Area = " & "'" & strArea & "'" & _
" ORDER BY Cases.Case_No;"
' this section is confusing
' strTemp is the QDF name. strSQL is built above and is assigned to qdf.SQL
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strArea
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\xyz\" & strAreaAbbrev & "\" & _
strArea & _
Format(CDate(strValDate), " mm-dd-yyyy") & ".xls"
rsArea.MoveNext
Debug.Print "Area report for " & strArea & " Done"
Loop
End If
Debug.Print "Done: "; Now()
rsArea.Close
Set rsArea = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
End Sub
I‘ve taken great bits of code (some from this site) to get pieces of what I need, but I’ve created a monster instead of an elephant.
The code needs to do ALL of the following:
1) Export memo fields that are greater than 255 characters (acExport will do that)
2) Loop thru the code to create a workbook (.xls) for each Area in a table
(This is based on a field in the database. (QueryDef does it)
3) The folder name is not the Area, but an abbreviation taken from tlbAreas. (DLookup)
4) The query is passed the Area – not the Abbreviation (qdfParmQry does it)
5) I would like to get a row count for each Area so I don’t have to open each workbook after it is created
(The count is entered into our production log.)
Currently I am running two queries – one to get the xls and one to get a row count. Ouch!
6) I would like the “export” code to be in a Query (e.g., 99-StdCandIExtract) not hard coded in the module.
(Then it can be used and maintained in the database - not in the module.)
7) One minor irritation – This code does a clean up at the end, but if this aborts I have to manually clean up the QueryDefs’ Z-queries or it dies.. How to fix this?
Here is the code using Access 2003 (minus some of the comments and debug bits)
Can it be simplified? (It is really ugly and is difficult to maintain. I'm still struggling with VBA)
Can it export (with >255 characters in memo fields) and count rows using one query? (I’ve looked but can’t find an acExport parm.)
Appreciate any help you can provide.
Sub CaseAndInv4Areas()
' This module will run a SQL query and drop it in the appropriate Service Area folder
' The Service Area name and abbreviation are in tblAreas (or tblAreasTest)
' The abbreviation indicates the folder name.
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rsArea As DAO.Recordset
Dim qdfParmQry As QueryDef 'the actual query object
Dim rsValDate As DAO.Recordset
Dim strSQL As String, strSQLRowCnt As String, strTemp As String, strArea As String, strAreaAbbrev As String, strValDate As String
Dim dtToDate As Date
Dim strTable As String
'Dim strMsg As String
'strTable = "tblAreas" ' for production
strTable = "tblAreasTest" ' for testing
Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
' get ValDate into strValDate - will be used as part of filename
strValDate = DLookup("[Valuation Date]", "Valuation")
' Create temporary query that will be used for exporting data;
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
' *** code to set strSQL
' Get list of Area values --
strSQL = "select DISTINCT Area FROM " & strTable & ";"
Set rsArea = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
Debug.Print "Start: "; Now()
' Now loop through list of Area values and create a query for each Area
' so that the data can be exported
If rsArea.EOF = False And rsArea.BOF = False Then
rsArea.MoveFirst
Do While rsArea.EOF = False
' pick up Folder name
strAreaAbbrev = DLookup("AreaAbbrev", strTable, "Area = '" & rsArea!Area.Value & "'")
' pick up Area for sql Where clause
strArea = rsArea!Area.Value
' *** code to set strSQL
Dim rsCount As Integer
Dim queryNameOrSQL As String
‘ this section uses a Query to get Row Count
Set qdfParmQry = dbs.QueryDefs("99-StdCandIExtract")
'qdfParmQry![Enter Service Area] = strArea
' or try this one
qdfParmQry("Enter Service Area") = strArea
Set rs = qdfParmQry.OpenRecordset()
rs.MoveLast
rsCount = rs.RecordCount
Debug.Print strArea & " .xls will have " & rsCount & " rows"
‘ simplified query for testing - wish this was a Query instead of hard-coded
strSQL = "select cases.case_no, investigations.inv_no " & _
"FROM Cases LEFT JOIN Investigations ON Cases.Case_No = Investigations.Case_No " & _
"WHERE " & _
"Cases.Area = " & "'" & strArea & "'" & _
" ORDER BY Cases.Case_No;"
' this section is confusing
' strTemp is the QDF name. strSQL is built above and is assigned to qdf.SQL
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strArea
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\xyz\" & strAreaAbbrev & "\" & _
strArea & _
Format(CDate(strValDate), " mm-dd-yyyy") & ".xls"
rsArea.MoveNext
Debug.Print "Area report for " & strArea & " Done"
Loop
End If
Debug.Print "Done: "; Now()
rsArea.Close
Set rsArea = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
End Sub
