Private Sub Command399_Click()
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strPathName As String
Dim blRet As Boolean
Dim rs As Recordset
Dim stDocName As String
Dim file As String
Dim strSavedSQL As String
If Me.Dirty Then Me.Dirty = False
stDocName = "sendtrips"
strSQL = "SELECT tblMasterLogisticare.id FROM tblMasterLogisticare WHERE (((triptaken)=True));"
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If rs.RecordCount < 1 Then
MsgBox "Nothing found to process", vbCritical, "Error"
Exit Sub
End If
' store the current SQL
Set qdf = CurrentDb.QueryDefs("sendtrip")
strSavedSQL = qdf.SQL
'qdf.Close
'Set qdf = Nothing
rs.MoveLast
rs.MoveFirst
Do
'Set qdf = CurrentDb.QueryDefs("sendtrip")
strSQL = Left(strSavedSQL, InStr(strSavedSQL, ";") - 1) & " and (tblMasterLogisticare.id = " & rs!id & ") ;"
qdf.SQL = strSQL
'qdf.Close
'Set qdf = Nothing
strPathName = "C:\orders\"
file = Report_Sendtrips![Location name a] & "-" & Report_Sendtrips![AJobnumber] & "-" & rs!id & ".pdf"
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, strPathName & file
rs.MoveNext
Loop Until rs.EOF
rs.Close
Set rs = Nothing
' restore the SQL
'Set qdf = CurrentDb.QueryDefs("sendtrip")
qdf.SQL = strSavedSQL
qdf.Close
Set qdf = Nothing
End SubPrivate Sub Command399_Click()[COLOR="Red"] 'recommend using meaningful control names[/COLOR]
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strPathName As String
[COLOR="red"]' Dim blRet As Boolean 'NOT USED[/COLOR]
Dim rs As [COLOR="Red"]DAO.[/COLOR]Recordset
Dim stDocName As String
Dim file As String
Dim strSavedSQL As String
If Me.Dirty Then Me.Dirty = False
stDocName = "sendtrips"
strSQL = "SELECT tblMasterLogisticare.id FROM tblMasterLogisticare WHERE (((triptaken)=True));"
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If rs.RecordCount < 1 Then
MsgBox "Nothing found to process", vbCritical, "Error"
Exit Sub
End If
' store the current SQL
Set qdf = CurrentDb.QueryDefs("sendtrip")
strSavedSQL = qdf.SQL
rs.MoveLast
rs.MoveFirst
Do Until rs.EOF
[COLOR="red"] 'What do these 2 lines actually do as they don't seem to be used for anything![/COLOR]
[COLOR="Red"] 'Try commenting these out as well[/COLOR]
[COLOR="RoyalBlue"] strSQL = Left(strSavedSQL, InStr(strSavedSQL, ";") - 1) & " And (tblMasterLogisticare.id = " & rs!id & ") ;"
qdf.SQL = strSQL[/COLOR]
strPathName = "C:\orders\"
file = Report_Sendtrips![Location name a] & "-" & Report_Sendtrips![AJobnumber] & "-" & rs!id & ".pdf"
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, strPathName & file
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
[COLOR="red"] ' restore the SQL - NOT NEEDED
'Set qdf = CurrentDb.QueryDefs("sendtrip")
' qdf.SQL = strSavedSQL 'OMIT [/COLOR]
qdf.Close
Set qdf = Nothing
End Sub“' Dim blRet As Boolean 'NOT USED”'What do these 2 lines actually do as they don't seem to be used for anything!
'Try commenting these out as well
strSQL = Left(strSavedSQL, InStr(strSavedSQL, ";") - 1) & " And (tblMasterLogisticare.id = " & rs!id & ") ;"
qdf.SQL = strSQL
...WHERE TripTaken = true;"WHERE TripTaken = true and tblTrips!ID=" & rs!IDdebug.print qdf.sql
Private Sub Command399_Click()
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strPathName As String
Dim blRet As Boolean
Dim rs As Recordset
Dim stDocName As String
Dim file As String
Dim strSavedSQL As String
'* arnelgp
Dim strSelect As String
Dim strWhere As String
Dim strOrderBy As String
Dim strGroupBy As String
Dim strHaving As String
If Me.Dirty Then Me.Dirty = False
stDocName = "sendtrips"
strSQL = "SELECT tblMasterLogisticare.id FROM tblMasterLogisticare WHERE (((triptaken)=True));"
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If rs.RecordCount < 1 Then
MsgBox "Nothing found to process", vbCritical, "Error"
Exit Sub
End If
' store the current SQL
Set qdf = CurrentDb.QueryDefs("sendtrip")
strSavedSQL = qdf.SQL
qdf.Close
Set qdf = Nothing
rs.MoveLast
rs.MoveFirst
Do
Set qdf = CurrentDb.QueryDefs("sendtrip")
strSQL = Replace(strSavedSQL, ";", "")
'* init variables
strSelect = vbNullString
strWhere = vbNullString
strOrderBy = vbNullString
strOrderBy = vbNullString
strGroupBy = vbNullString
strHaving = vbNullString
'* parse these values
ParseSQL strSQL, strSelect, strWhere, strOrderBy, strGroupBy, strHaving
'* we have the Where Clause in strWhere
If strWhere <> vbNullString Then
strWhere = strWhere & " And (tblMasterLogisticare.id = " & rs!id & ")"
Else
strWhere = "(tblMasterLogisticare.id = " & rs!id & ")"
End If
'* replace the Where Clause
strSQL = ReplaceWhereClause(strSelect, strWhere)
'strSQL = Left(strSavedSQL, InStr(strSavedSQL, ";") - 1) & " and (tblMasterLogisticare.id = " & rs!id & ") ;"
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
strPathName = "C:\orders\"
file = Report_Sendtrips![Location name a] & "-" & Report_Sendtrips![AJobnumber] & "-" & rs!id & ".pdf"
'* check if file already exists and delete if exists
If Dir(strPathName & file) <> vbnullstring Then Kill (strPathName & file)
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, strPathName & file
rs.MoveNext
Loop Until rs.EOF
rs.Close
Set rs = Nothing
'restore the SQL
Set qdf = CurrentDb.QueryDefs("sendtrip")
qdf.SQL = strSavedSQL
qdf.Close
Set qdf = Nothing
End SubOption Compare Database
Option Explicit
'***************************************************************************************
' Module : basSQLParser
' Author : Excerpt from Access 2007 VBA - Programmer's Reference - Wrox WW
' Date :
' Purpose :
'***************************************************************************************
Public Sub ParseSQL(ByVal strSQL As String, _
ByRef strSelect As String, _
ByRef strWhere As String, _
ByRef strOrderBy As String, _
ByRef strGROUPBY As String, _
ByRef strHAVING As String)
On Error GoTo Error_Handler
'
'This subroutine accepts a valid SQL string and passes back separated
'SELECT, WHERE, ORDER BY, and GROUP BY clauses.
'
'INPUT:
' strSQL valid SQL string to parse
'OUTPUT:
' strSELECT SELECT portion of SQL (includes JOIN info)
' strWHERE WHERE portion of SQL
' strORDERBY ORDER BY portion of SQL
' strGROUPBY GROUP BY portion of SQL
' strHAVING HAVING portion of SQL
Dim intStartSELECT As Integer
Dim intStartWHERE As Integer
Dim intStartORDERBY As Integer
Dim intStartGROUPBY As Integer
Dim intStartHAVING As Integer
Dim intLenSELECT As Integer
Dim intLenWHERE As Integer
Dim intLenORDERBY As Integer
Dim intLenGROUPBY As Integer
Dim intLenHAVING As Integer
Dim intLenSQL As Integer
intStartSELECT = InStr(strSQL, "SELECT ")
intStartWHERE = InStr(strSQL, "WHERE ")
intStartORDERBY = InStr(strSQL, "ORDER BY ")
intStartGROUPBY = InStr(strSQL, "GROUP BY ")
intStartHAVING = InStr(strSQL, "HAVING ")
'if there's no GROUP BY, there can't be a HAVING
If intStartGROUPBY = 0 Then
intStartHAVING = 0
End If
If InStr(strSQL, ";") Then 'if it exists, trim off the ';'
strSQL = Left(strSQL, InStr(strSQL, ";") - 1)
End If
intLenSQL = Len(strSQL)
' find length of Select portion
If intStartSELECT > 0 Then
' start with longest it could be
intLenSELECT = intLenSQL - intStartSELECT + 1
If intStartWHERE > 0 And intStartWHERE > intStartSELECT _
And intStartWHERE < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartWHERE - intStartSELECT
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartSELECT _
And intStartORDERBY < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartORDERBY - intStartSELECT
End If
If intStartGROUPBY > 0 And intStartGROUPBY > intStartSELECT _
And intStartGROUPBY < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartGROUPBY - intStartSELECT
End If
If intStartHAVING > 0 And intStartHAVING > intStartSELECT _
And intStartHAVING < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartHAVING - intStartSELECT
End If
End If
' find length of GROUPBY portion
If intStartGROUPBY > 0 Then
' start with longest it could be
intLenGROUPBY = intLenSQL - intStartGROUPBY + 1
If intStartWHERE > 0 And intStartWHERE > intStartGROUPBY _
And intStartWHERE < intStartGROUPBY + intLenGROUPBY Then
'we found a new portion closer to this one
intLenGROUPBY = intStartWHERE - intStartGROUPBY
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartGROUPBY _
And intStartORDERBY < intStartGROUPBY + intLenGROUPBY Then
'we found a new portion closer to this one
intLenGROUPBY = intStartORDERBY - intStartGROUPBY
End If
If intStartHAVING > 0 And intStartHAVING > intStartGROUPBY _
And intStartHAVING < intStartGROUPBY + intLenGROUPBY Then
'we found a new portion closer to this one
intLenGROUPBY = intStartHAVING - intStartGROUPBY
End If
End If
' find length of HAVING portion
If intStartHAVING > 0 Then
' start with longest it could be
intLenHAVING = intLenSQL - intStartHAVING + 1
If intStartWHERE > 0 And intStartWHERE > intStartHAVING _
And intStartWHERE < intStartHAVING + intLenHAVING Then
'we found a new portion closer to this one
intLenHAVING = intStartWHERE - intStartHAVING
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartHAVING _
And intStartORDERBY < intStartHAVING + intLenHAVING Then
'we found a new portion closer to this one
intLenHAVING = intStartORDERBY - intStartHAVING
End If
If intStartGROUPBY > 0 And intStartGROUPBY > intStartHAVING _
And intStartGROUPBY < intStartHAVING + intLenHAVING Then
'we found a new portion closer to this one
intLenHAVING = intStartGROUPBY - intStartHAVING
End If
End If
' find length of ORDERBY portion
If intStartORDERBY > 0 Then
' start with longest it could be
intLenORDERBY = intLenSQL - intStartORDERBY + 1
If intStartWHERE > 0 And intStartWHERE > intStartORDERBY _
And intStartWHERE < intStartORDERBY + intLenORDERBY Then
'we found a new portion closer to this one
intLenORDERBY = intStartWHERE - intStartORDERBY
End If
If intStartGROUPBY > 0 And intStartGROUPBY > intStartORDERBY _
And intStartGROUPBY < intStartORDERBY + intLenORDERBY Then
'we found a new portion closer to this one
intLenORDERBY = intStartGROUPBY - intStartORDERBY
End If
If intStartHAVING > 0 And intStartHAVING > intStartORDERBY _
And intStartHAVING < intStartORDERBY + intLenORDERBY Then
'we found a new portion closer to this one
intLenORDERBY = intStartHAVING - intStartORDERBY
End If
End If
' find length of WHERE portion
If intStartWHERE > 0 Then
' start with longest it could be
intLenWHERE = intLenSQL - intStartWHERE + 1
If intStartGROUPBY > 0 And intStartGROUPBY > intStartWHERE _
And intStartGROUPBY < intStartWHERE + intLenWHERE Then
'we found a new portion closer to this one
intLenWHERE = intStartGROUPBY - intStartWHERE
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartWHERE _
And intStartORDERBY < intStartWHERE + intLenWHERE Then
'we found a new portion closer to this one
intLenWHERE = intStartORDERBY - intStartWHERE
End If
If intStartHAVING > 0 And intStartHAVING > intStartWHERE _
And intStartHAVING < intStartWHERE + intLenWHERE Then
'we found a new portion closer to this one
intLenWHERE = intStartHAVING - intStartWHERE
End If
End If
' set each output portion
If intStartSELECT > 0 Then
strSelect = Mid$(strSQL, intStartSELECT, intLenSELECT)
End If
If intStartGROUPBY > 0 Then
strGROUPBY = Mid$(strSQL, intStartGROUPBY, intLenGROUPBY)
End If
If intStartHAVING > 0 Then
strHAVING = Mid$(strSQL, intStartHAVING, intLenHAVING)
End If
If intStartORDERBY > 0 Then
strOrderBy = Mid$(strSQL, intStartORDERBY, intLenORDERBY)
End If
If intStartWHERE > 0 Then
strWhere = Mid$(strSQL, intStartWHERE, intLenWHERE)
End If
Exit_Procedure:
Exit Sub
Error_Handler:
MsgBox (err.Number & ": " & err.Description)
Resume Exit_Procedure
End Sub
Public Function ReplaceWhereClause(ByVal strSQL As String, ByVal strNewWHERE As String) As String
On Error GoTo Error_Handler
'This subroutine accepts a valid SQL string and Where clause, and
'returns the same SQL statement with the original Where clause (if any)
'replaced by the passed in Where clause.
'
'INPUT:
' strSQL valid SQL string to change
'OUTPUT:
' strNewWHERE New WHERE clause to insert into SQL statement
'
Dim strSelect As String, strWhere As String
Dim strOrderBy As String, strGROUPBY As String, strHAVING As String
Call ParseSQL(strSQL, strSelect, strWhere, strOrderBy, _
strGROUPBY, strHAVING)
ReplaceWhereClause = BuildSQLString(strSelect, strNewWHERE, strOrderBy, _
strGROUPBY, strHAVING)
Exit_Procedure:
Exit Function
Error_Handler:
MsgBox (err.Number & ": " & err.Description)
Resume Exit_Procedure
End Function
Public Function ReplaceOrderByClause(ByVal strSQL As String, ByVal strNewOrderBy As String) As String
On Error GoTo Error_Handler
'
'INPUT:
' strSQL valid SQL string to change
'OUTPUT:
' strNewOrderBy New OrderBy clause to insert into SQL statement
'
Dim strSelect As String, strWhere As String
Dim strOrderBy As String, strGROUPBY As String, strHAVING As String
Call ParseSQL(strSQL, strSelect, strWhere, strOrderBy, _
strGROUPBY, strHAVING)
ReplaceOrderByClause = BuildSQLString(strSelect, strWhere, strNewOrderBy, _
strGROUPBY, strHAVING)
Exit_Procedure:
Exit Function
Error_Handler:
MsgBox (err.Number & ": " & err.Description)
Resume Exit_Procedure
End Function
Private Function BuildSQLString(ByVal strSelect As String, ByVal strWhere As String, ByVal strOrderBy As String, _
ByVal strGROUPBY As String, ByVal strHAVING As String) As String
BuildSQLString = strSelect
If strWhere <> "" Then BuildSQLString = BuildSQLString & " WHERE " & strWhere
If strGROUPBY <> "" Then BuildSQLString = BuildSQLString & " GROUP BY " & strGROUPBY
If strHAVING <> "" Then BuildSQLString = BuildSQLString & " HAVING " & strHAVING
If strOrderBy <> "" Then BuildSQLString = BuildSQLString & " ORDER BY " & strOrderBy
BuildSQLString = Replace(BuildSQLString, " ", " ")
End FunctionPrivate Sub Command399_Click() [COLOR="SeaGreen"]'recommend using meaningful control names[/COLOR]
[COLOR="SeaGreen"] 'Dim qdf As DAO.QueryDef 'NO LONGER USED[/COLOR]
Dim strSQL As String
Dim strPathName As String
Dim rs As DAO.Recordset
Dim stDocName As String
Dim strFileName As String
[COLOR="seagreen"] ' Dim strSavedSQL As String 'NO LONGER USED[/COLOR]
If Me.Dirty Then Me.Dirty = False
[COLOR="seagreen"] 'get SQL for recordset
'if all 3 fields aren't in this table, adapt it to create a query from more than one table to include them [/COLOR]
strSQL = "SELECT tblMasterLogisticare.id, tblMasterLogisticare.[Location name a], tblMasterLogisticare.AJobnumber FROM tblMasterLogisticare WHERE (((TripTaken)=True));"
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If rs.RecordCount < 1 Then
MsgBox "Nothing found to process", vbCritical, "Error"
Exit Sub
End If
With rs
.MoveLast
.MoveFirst
Do Until .EOF
stDocName = "sendtrips"
strPathName = "C:\orders\"
strFileName = ![Location name a] & "-" & !AJobnumber & "-" & !id & ".pdf"
Debug.Print strFileName[COLOR="seagreen"] 'check output file name[/COLOR]
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, strPathName & strFileName
.MoveNext
Loop
.Close
End With
[COLOR="SeaGreen"] 'clear up[/COLOR]
Set rs = Nothing
End SubCode gave me correct file names but dumped all records in each file.
Option Compare Database
Option Explicit
'***************************************************************************************
' Module : basSQLParser
' Author : Excerpt from Access 2007 VBA - Programmer's Reference - Wrox WW
' Date :
' Purpose :
'***************************************************************************************
Public Sub ParseSQL(ByVal strSQL As String, _
ByRef strSelect As String, _
ByRef strWhere As String, _
ByRef strOrderBy As String, _
ByRef strGROUPBY As String, _
ByRef strHAVING As String)
On Error GoTo Error_Handler
'
'This subroutine accepts a valid SQL string and passes back separated
'SELECT, WHERE, ORDER BY, and GROUP BY clauses.
'
'INPUT:
' strSQL valid SQL string to parse
'OUTPUT:
' strSELECT SELECT portion of SQL (includes JOIN info)
' strWHERE WHERE portion of SQL
' strORDERBY ORDER BY portion of SQL
' strGROUPBY GROUP BY portion of SQL
' strHAVING HAVING portion of SQL
Dim intStartSELECT As Integer
Dim intStartWHERE As Integer
Dim intStartORDERBY As Integer
Dim intStartGROUPBY As Integer
Dim intStartHAVING As Integer
Dim intLenSELECT As Integer
Dim intLenWHERE As Integer
Dim intLenORDERBY As Integer
Dim intLenGROUPBY As Integer
Dim intLenHAVING As Integer
Dim intLenSQL As Integer
intStartSELECT = InStr(strSQL, "SELECT ")
intStartWHERE = InStr(strSQL, "WHERE ")
intStartORDERBY = InStr(strSQL, "ORDER BY ")
intStartGROUPBY = InStr(strSQL, "GROUP BY ")
intStartHAVING = InStr(strSQL, "HAVING ")
'if there's no GROUP BY, there can't be a HAVING
If intStartGROUPBY = 0 Then
intStartHAVING = 0
End If
If InStr(strSQL, ";") Then 'if it exists, trim off the ';'
strSQL = Left(strSQL, InStr(strSQL, ";") - 1)
End If
intLenSQL = Len(strSQL)
' find length of Select portion
If intStartSELECT > 0 Then
' start with longest it could be
intLenSELECT = intLenSQL - intStartSELECT + 1
If intStartWHERE > 0 And intStartWHERE > intStartSELECT _
And intStartWHERE < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartWHERE - intStartSELECT
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartSELECT _
And intStartORDERBY < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartORDERBY - intStartSELECT
End If
If intStartGROUPBY > 0 And intStartGROUPBY > intStartSELECT _
And intStartGROUPBY < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartGROUPBY - intStartSELECT
End If
If intStartHAVING > 0 And intStartHAVING > intStartSELECT _
And intStartHAVING < intStartSELECT + intLenSELECT Then
'we found a new portion closer to this one
intLenSELECT = intStartHAVING - intStartSELECT
End If
End If
' find length of GROUPBY portion
If intStartGROUPBY > 0 Then
' start with longest it could be
intLenGROUPBY = intLenSQL - intStartGROUPBY + 1
If intStartWHERE > 0 And intStartWHERE > intStartGROUPBY _
And intStartWHERE < intStartGROUPBY + intLenGROUPBY Then
'we found a new portion closer to this one
intLenGROUPBY = intStartWHERE - intStartGROUPBY
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartGROUPBY _
And intStartORDERBY < intStartGROUPBY + intLenGROUPBY Then
'we found a new portion closer to this one
intLenGROUPBY = intStartORDERBY - intStartGROUPBY
End If
If intStartHAVING > 0 And intStartHAVING > intStartGROUPBY _
And intStartHAVING < intStartGROUPBY + intLenGROUPBY Then
'we found a new portion closer to this one
intLenGROUPBY = intStartHAVING - intStartGROUPBY
End If
End If
' find length of HAVING portion
If intStartHAVING > 0 Then
' start with longest it could be
intLenHAVING = intLenSQL - intStartHAVING + 1
If intStartWHERE > 0 And intStartWHERE > intStartHAVING _
And intStartWHERE < intStartHAVING + intLenHAVING Then
'we found a new portion closer to this one
intLenHAVING = intStartWHERE - intStartHAVING
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartHAVING _
And intStartORDERBY < intStartHAVING + intLenHAVING Then
'we found a new portion closer to this one
intLenHAVING = intStartORDERBY - intStartHAVING
End If
If intStartGROUPBY > 0 And intStartGROUPBY > intStartHAVING _
And intStartGROUPBY < intStartHAVING + intLenHAVING Then
'we found a new portion closer to this one
intLenHAVING = intStartGROUPBY - intStartHAVING
End If
End If
' find length of ORDERBY portion
If intStartORDERBY > 0 Then
' start with longest it could be
intLenORDERBY = intLenSQL - intStartORDERBY + 1
If intStartWHERE > 0 And intStartWHERE > intStartORDERBY _
And intStartWHERE < intStartORDERBY + intLenORDERBY Then
'we found a new portion closer to this one
intLenORDERBY = intStartWHERE - intStartORDERBY
End If
If intStartGROUPBY > 0 And intStartGROUPBY > intStartORDERBY _
And intStartGROUPBY < intStartORDERBY + intLenORDERBY Then
'we found a new portion closer to this one
intLenORDERBY = intStartGROUPBY - intStartORDERBY
End If
If intStartHAVING > 0 And intStartHAVING > intStartORDERBY _
And intStartHAVING < intStartORDERBY + intLenORDERBY Then
'we found a new portion closer to this one
intLenORDERBY = intStartHAVING - intStartORDERBY
End If
End If
' find length of WHERE portion
If intStartWHERE > 0 Then
' start with longest it could be
intLenWHERE = intLenSQL - intStartWHERE + 1
If intStartGROUPBY > 0 And intStartGROUPBY > intStartWHERE _
And intStartGROUPBY < intStartWHERE + intLenWHERE Then
'we found a new portion closer to this one
intLenWHERE = intStartGROUPBY - intStartWHERE
End If
If intStartORDERBY > 0 And intStartORDERBY > intStartWHERE _
And intStartORDERBY < intStartWHERE + intLenWHERE Then
'we found a new portion closer to this one
intLenWHERE = intStartORDERBY - intStartWHERE
End If
If intStartHAVING > 0 And intStartHAVING > intStartWHERE _
And intStartHAVING < intStartWHERE + intLenWHERE Then
'we found a new portion closer to this one
intLenWHERE = intStartHAVING - intStartWHERE
End If
End If
' set each output portion
If intStartSELECT > 0 Then
strSelect = Mid$(strSQL, intStartSELECT, intLenSELECT)
End If
If intStartGROUPBY > 0 Then
strGROUPBY = Mid$(strSQL, intStartGROUPBY, intLenGROUPBY)
End If
If intStartHAVING > 0 Then
strHAVING = Mid$(strSQL, intStartHAVING, intLenHAVING)
End If
If intStartORDERBY > 0 Then
strOrderBy = Mid$(strSQL, intStartORDERBY, intLenORDERBY)
End If
If intStartWHERE > 0 Then
strWhere = Mid$(strSQL, intStartWHERE, intLenWHERE)
End If
Exit_Procedure:
Exit Sub
Error_Handler:
MsgBox (err.Number & ": " & err.Description)
Resume Exit_Procedure
End Sub
Public Function ReplaceWhereClause(ByVal strSQL As String, ByVal strNewWHERE As String) As String
On Error GoTo Error_Handler
'This subroutine accepts a valid SQL string and Where clause, and
'returns the same SQL statement with the original Where clause (if any)
'replaced by the passed in Where clause.
'
'INPUT:
' strSQL valid SQL string to change
'OUTPUT:
' strNewWHERE New WHERE clause to insert into SQL statement
'
Dim strSelect As String, strWhere As String
Dim strOrderBy As String, strGROUPBY As String, strHAVING As String
Call ParseSQL(strSQL, strSelect, strWhere, strOrderBy, _
strGROUPBY, strHAVING)
ReplaceWhereClause = BuildSQLString(strSelect, strNewWHERE, strOrderBy, _
strGROUPBY, strHAVING)
Exit_Procedure:
Exit Function
Error_Handler:
MsgBox (err.Number & ": " & err.Description)
Resume Exit_Procedure
End Function
Public Function ReplaceOrderByClause(ByVal strSQL As String, ByVal strNewOrderBy As String) As String
On Error GoTo Error_Handler
'
'INPUT:
' strSQL valid SQL string to change
'OUTPUT:
' strNewOrderBy New OrderBy clause to insert into SQL statement
'
Dim strSelect As String, strWhere As String
Dim strOrderBy As String, strGROUPBY As String, strHAVING As String
Call ParseSQL(strSQL, strSelect, strWhere, strOrderBy, _
strGROUPBY, strHAVING)
ReplaceOrderByClause = BuildSQLString(strSelect, strWhere, strNewOrderBy, _
strGROUPBY, strHAVING)
Exit_Procedure:
Exit Function
Error_Handler:
MsgBox (err.Number & ": " & err.Description)
Resume Exit_Procedure
End Function
Private Function BuildSQLString(ByVal strSelect As String, ByVal strWhere As String, ByVal strOrderBy As String, _
ByVal strGROUPBY As String, ByVal strHAVING As String) As String
BuildSQLString = strSelect
If strWhere <> "" Then BuildSQLString = BuildSQLString & " WHERE " & strWhere
If strGROUPBY <> "" Then BuildSQLString = BuildSQLString & " GROUP BY " & strGROUPBY
If strHAVING <> "" Then BuildSQLString = BuildSQLString & " HAVING " & strHAVING
If strOrderBy <> "" Then BuildSQLString = BuildSQLString & " ORDER BY " & strOrderBy
BuildSQLString = Replace(BuildSQLString, " ", " ")
End Function
Private Sub cmdSaveAsPDF_Click()
Dim qdf As DAO.QueryDef
Dim strPathName As String
Dim rs As Recordset
Dim stDocName As String
Dim strSavedSQL As String
If Me.Dirty Then Me.Dirty = False
stDocName = "xinvoice"
Set rs = CurrentDb.OpenRecordset("SELECT orderid, tripname FROM Orders WHERE SelectedPrint;", dbOpenSnapshot)
If rs.EOF Then
MsgBox "Nothing found to process", vbCritical, "Error"
Else
CreateFolder CurrentProject.Path & "\orders"
' store the current SQL
Set qdf = CurrentDb.QueryDefs("Invoices")
strSavedSQL = qdf.SQL
While Not rs.EOF
qdf.SQL = Left(strSavedSQL, InStr(strSavedSQL, ";") - 1) & " and (orderid = " & rs!OrderID & ");"
' put in the same folder as the database
strPathName = CurrentProject.Path & "\orders\" & rs!tripname & ".pdf"
DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, strPathName
rs.MoveNext
Wend
' restore the SQL
qdf.SQL = strSavedSQL
qdf.Close
Set qdf = Nothing
End If
rs.Close
Set rs = Nothing
End Sub
