Criteria Range for generating Recordset (syntax help)

E

efandango

I have some code which outputs records based on a single [Run_No]. I now want
to output a range using 'Between [Run No] And [Run Nos]' from the query. How
do I adjust the following code to accomodate the range of numbers, instead of
just one Run No?



the code:
**********************************
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strRun_No As String
Dim lngFN As Long


'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN

strRun_No = InputBox("Enter the Run No")
If Len(strRun_No) > 0 Then
Set db = CurrentDb()
Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("Run No") = strRun_No
qdf![Run No] = strRun_No

'Output header
'NB: need to double quotes in literal strings
Print #lngFN, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #lngFN, "<kml xmlns=""http://earth.google.com/kml/2.0"">"
Print #lngFN, "<Document>"
Print #lngFN, "<name>Run Points " & strRun_No & "</name>"
Print #lngFN, "<Folder>"
'Print #lngFN, "<name>Locations</name>"
Print #lngFN, "<open>1</open>"

Set rs = qdf.OpenRecordset(dbOpenSnapshot)
Do Until rs.EOF = True
'Print #lngFN, rs.Fields("KML_Address")
Dim strWork As String

strWork = rs.Fields("KML_Address")
strWork = Replace(strWork, "&", "&")
strWork = Replace(strWork, "'", "&apos;")
'strWork = Replace(strWork, "<", "<")
Print #lngFN, strWork

rs.MoveNext
Loop
rs.Close
'Output footer
Print #lngFN, "</Folder>"
Print #lngFN, "</Document>"
Print #lngFN, "</kml>"
Close #lngFN
End If

On Error GoTo Err_Google_Earth_Points_Click

Dim stAppName As String

stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"
Call Shell(stAppName, 1)

Exit_Google_Earth_Points_Click:
Exit Sub

Err_Google_Earth_Points_Click:
MsgBox Err.Description
Resume Exit_Google_Earth_Points_Click
**********************************
 
B

Bob Barrows [MVP]

efandango said:
I have some code which outputs records based on a single [Run_No]. I
now want to output a range using 'Between [Run No] And [Run Nos]'
from the query. How do I adjust the following code to accomodate the
range of numbers, instead of just one Run No?


Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("Run No") = strRun_No
qdf![Run No] = strRun_No
Click to expand...

?? Why do you assign this value twice?
You need to write a new saved query that contains this sql (assuming that
Run_No is the name of the field):

WHERE [Run_No) BETWEEN [StartRun] And [EndRun]

The querydef pointed at this query will have two parameters instead of one.

Set qdf = db.QueryDefs("New_Saved_Query")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_No
 
E

efandango

Bob,

I replaced the code as you suggested, but it still exports a list based on
the first Run No only, that I Input. I think this is because the 'Message
Input box' that pops up only offers the first criteria form the query. like
this: strRun_No = InputBox("Enter the Run No")

FYI: the query works fine run standalone.

My current code:
****************
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strRun_No As String
Dim lngFN As Long


'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN

strRun_No = InputBox("Enter the Run No")
If Len(strRun_No) > 0 Then
Set db = CurrentDb()

Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_No


'Output header
'NB: need to double quotes in literal strings
Print #lngFN, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #lngFN, "<kml xmlns=""http://earth.google.com/kml/2.0"">"
Print #lngFN, "<Document>"
Print #lngFN, "<name>Run Points " & strRun_No & "</name>"
Print #lngFN, "<Folder>"
'Print #lngFN, "<name>Locations</name>"
Print #lngFN, "<open>1</open>"

Set rs = qdf.OpenRecordset(dbOpenSnapshot)
Do Until rs.EOF = True
'Print #lngFN, rs.Fields("KML_Address")
Dim strWork As String

strWork = rs.Fields("KML_Address")
strWork = Replace(strWork, "&", "&")
strWork = Replace(strWork, "'", "&apos;")
'strWork = Replace(strWork, "<", "<")
Print #lngFN, strWork

rs.MoveNext
Loop
rs.Close
'Output footer
Print #lngFN, "</Folder>"
Print #lngFN, "</Document>"
Print #lngFN, "</kml>"
Close #lngFN
End If

On Error GoTo Err_Google_Earth_Points_Click

Dim stAppName As String

stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"
Call Shell(stAppName, 1)

Exit_Google_Earth_Points_Click:
Exit Sub

Err_Google_Earth_Points_Click:
MsgBox Err.Description
Resume Exit_Google_Earth_Points_Click
********************

Bob Barrows said:
efandango said:
I have some code which outputs records based on a single [Run_No]. I
now want to output a range using 'Between [Run No] And [Run Nos]'
from the query. How do I adjust the following code to accomodate the
range of numbers, instead of just one Run No?


Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("Run No") = strRun_No
qdf![Run No] = strRun_No
Click to expand...

?? Why do you assign this value twice?
You need to write a new saved query that contains this sql (assuming that
Run_No is the name of the field):

WHERE [Run_No) BETWEEN [StartRun] And [EndRun]

The querydef pointed at this query will have two parameters instead of one.

Set qdf = db.QueryDefs("New_Saved_Query")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_No


--
Microsoft MVP - ASP/ASP.NET - 2004-2007
Please reply to the newsgroup. This email account is my spam trap so I
don't check it very often. If you must reply off-line, then remove the
"NO SPAM"
Click to expand...
 
B

Bob Barrows [MVP]

efandango said:
Bob,

I replaced the code as you suggested, but it still exports a list
based on the first Run No only, that I Input. I think this is because
the 'Message Input box' that pops up only offers the first criteria
form the query. like this: strRun_No = InputBox("Enter the Run No")
Click to expand...

Well, I expected you would know to add another message box....

Dim strStartRun_No As String
Dim strEndRun_No As String
strStartRun_No = InputBox("Enter the lower Run No")
strEndRun_No = InputBox("Enter the higher Run No")
Set qdf = db.QueryDefs("New_Saved_Query")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_No
 
E

efandango

Bob, It worked!. But at first it didn't, instead it was outputting an empty
file. So I changed (figuring that the first line was no longer true)

this line: If Len(strRun_No) > 0 Then

to this: If Len(strStartRun_No) > 0 Then


I didn't know how to add another message box. I'm a novice at this, and the
original code was not my creation, but was created by another helpful MVP
some time ago. I simply adapted it for my use.

I am very grateful for timely your help.

here is my now working code:


**************************

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strStartRun_No As String
Dim strEndRun_No As String
' Dim strRun_No As String
Dim lngFN As Long



'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN

strStartRun_No = InputBox("Enter the lower Run No")
strEndRun_No = InputBox("Enter the higher Run No")
If Len(strStartRun_No) > 0 Then
Set db = CurrentDb()
Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_No

'Output header
'NB: need to double quotes in literal strings
Print #lngFN, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #lngFN, "<kml xmlns=""http://earth.google.com/kml/2.0"">"
Print #lngFN, "<Document>"
Print #lngFN, "<name>Run Points " & strRun_No & "</name>"
Print #lngFN, "<Folder>"
'Print #lngFN, "<name>Locations</name>"
Print #lngFN, "<open>1</open>"

Set rs = qdf.OpenRecordset(dbOpenSnapshot)
Do Until rs.EOF = True
'Print #lngFN, rs.Fields("KML_Address")
Dim strWork As String

strWork = rs.Fields("KML_Address")
strWork = Replace(strWork, "&", "&")
strWork = Replace(strWork, "'", "&apos;")
'strWork = Replace(strWork, "<", "<")
Print #lngFN, strWork

rs.MoveNext
Loop
rs.Close
'Output footer
Print #lngFN, "</Folder>"
Print #lngFN, "</Document>"
Print #lngFN, "</kml>"
Close #lngFN
End If

On Error GoTo Err_Google_Earth_Points_Click

Dim stAppName As String


stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"

Call Shell(stAppName, 1)

Exit_Google_Earth_Points_Click:
Exit Sub

Err_Google_Earth_Points_Click:
MsgBox Err.Description
Resume Exit_Google_Earth_Points_Click

**********************
 
B

Bob Barrows [MVP]

efandango said:
Bob, It worked!. But at first it didn't, instead it was outputting an
empty file. So I changed (figuring that the first line was no longer
true)

this line: If Len(strRun_No) > 0 Then

to this: If Len(strStartRun_No) > 0 Then
Click to expand...

Well, you should be testing both variables ...
If Len(strStartRun_No) > 0 And Len(strEndRun_No) > 0 Then
I didn't know how to add another message box. I'm a novice at this,
and the original code was not my creation, but was created by another
helpful MVP some time ago. I simply adapted it for my use.
Click to expand...

You might want to consider using an unbound form rather than InputBox
statements. Let us know if you want to try it and need specifics.
 
E

efandango

Bob,

I hear you, but for now the purpose of the project dictates that both
numbers will be inputted. But something else has come up by way of you
introducing me to mutliple message boxes...


When this exported file goes into google earth, the <name> variable is fixed
to 'Run Points' like this:
Print #lngFN, "<name>Run Points " & strRun_No & "</name>"

So I added/replace these lines:

Dim FileTitle As String

FileTitle = InputBox("Enter the file title")

Print #lngFN, "<name>FileTitle " & strRun_No & "</name>"

but when I open the file, the title is literally 'FileTitle', I can see why
it has doen this, but can't work out how to have the code replace it with the
variable input from the message box; what am I overlooking here?

My Code:

**********************
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strStartRun_No As String
Dim strEndRun_No As String
Dim FileTitle As String
' Dim strRun_No As String
Dim lngFN As Long



'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN

strStartRun_No = InputBox("Enter the lower Run No")
strEndRun_No = InputBox("Enter the higher Run No")
FileTitle = InputBox("Enter the file title")

If Len(strStartRun_No) > 0 Then
Set db = CurrentDb()
Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_No

'Output header
'NB: need to double quotes in literal strings
Print #lngFN, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #lngFN, "<kml xmlns=""http://earth.google.com/kml/2.0"">"
Print #lngFN, "<Document>"
Print #lngFN, "<name>FileTitle " & strRun_No & "</name>"
Print #lngFN, "<Folder>"
'Print #lngFN, "<name>Locations</name>"
Print #lngFN, "<open>1</open>"

Set rs = qdf.OpenRecordset(dbOpenSnapshot)
Do Until rs.EOF = True
'Print #lngFN, rs.Fields("KML_Address")
Dim strWork As String

strWork = rs.Fields("KML_Address")
strWork = Replace(strWork, "&", "&")
strWork = Replace(strWork, "'", "&apos;")
'strWork = Replace(strWork, "<", "<")
Print #lngFN, strWork

rs.MoveNext
Loop
rs.Close
'Output footer
Print #lngFN, "</Folder>"
Print #lngFN, "</Document>"
Print #lngFN, "</kml>"
Close #lngFN
End If

On Error GoTo Err_Google_Earth_Points_Click

Dim stAppName As String


stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"

Call Shell(stAppName, 1)

Exit_Google_Earth_Points_Click:
Exit Sub

Err_Google_Earth_Points_Click:
MsgBox Err.Description
Resume Exit_Google_Earth_Points_Click

****************************
 
B

Bob Barrows [MVP]

efandango said:
Bob,

I hear you, but for now the purpose of the project dictates that both
numbers will be inputted. But something else has come up by way of you
introducing me to mutliple message boxes...


When this exported file goes into google earth, the <name> variable
is fixed to 'Run Points' like this:
Print #lngFN, "<name>Run Points " & strRun_No & "</name>"

So I added/replace these lines:

Dim FileTitle As String

FileTitle = InputBox("Enter the file title")

Print #lngFN, "<name>FileTitle " & strRun_No & "</name>"
Click to expand...

You have to use the variable ...

Print #lngFN, "<name>FileTitle " & FileTitle & "</name>"

It's only doing what you tell it to do.
 
E

efandango

Bob, of course! "It's only doing what you tell it to do."

Print #lngFN, "<name>" & FileTitle & "</name>"

that's cured it.

you have taught me things. thanks so much.

regards

Eric
 
E

efandango

Bob,

Doing this overall improvement has thrown up another issue. It relates to
the 'FileTitle'. When I open the file ?, it contains the correct Google Eath
internal File name. But I now need to be able to define the actual system
File Name using a message box. At the moment, the code opens up an existing
file name called: Addresses.kml" within this line:

Open "W:\Folder\Addresses.kml" For Output As #lngFN

and then runs it using:

stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"

I want to be able to incorporate the 'on the fly' File Name instead of the
pre-exisitng fixed file name 'Addresses.kml'. I can handle the Message box
and defining the variable stuff now, but what would the syntax be for
incorporating the variable File Name into those two lines. I realise that the
first line relies on the actual File Name exisitng, so would need to make it
so that it first generated the (variable) File Name, then placed the variable
into the calling code:

stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"

Call Shell(stAppName, 1)

Can you tell me how to do this?
 

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

Create an export file using user generated title and export data t 6
Need help with Loop that is not repeating the function 11
Output UTF-8 encoding through VBA 6
Outlook Microsoft Outlook VBA Macro 1
Help in Assigning value using recordset 2
User Define Array Data Type - Subscript out of range 7
Sending mail from outlook using VBA masro 1
Help with found code 23

Top