|
AditMap
was designed as a
desktop mapping tool.
The primary design
objectives were to make
the task of creating
maps straightforward and
to provide a means to
plot data upon the maps
created. The first
version of AditMap came
fully equipped with a
data entry and storage
facility so that data
could be plotted on a
range of maps - AditMap
also provided a DDE
facility to provide a
clipboard paste link to
external data sets
stored in a spreadsheet.
The current version of
AditMap comes as an
ActiveX exe with a
public interface that
can be called from any
programming language
that supports COM
objects and that
includes Visual Basic
for Applications (VBA).
Nigel Clemons has
made use of the latest
version of AditMap to
automate the selection
and plotting of data
stored within an MS
Access database. He has
used VBA to select the
data and to automate the
link to AditMap to plot
and display that data on
his maps. We would like
to thank Nigel for
making his code
available as a
demonstration of how
straightforward it is to
add a mapping facility
to any application.
Nigel has provided 6
VBA functions that each
demonstrate different
aspects of the AditMap
link and the data
selection process. There
is something here for
everyone. You can see
dates being used within SQL
selection statements
as well as some
techniques for selecting
data by ordnance survey
grid reference that
allows plotting to a
range of precisions. The
source database is (in
this instance) a
database containing
records of amphibians
and reptiles but the
same techniques can be
applied to all areas of
study. If the long code
listing looks a bit
daunting then do not
worry as the AditMap
link itself is simple to
apply in just about
any computer development
language.
Option Compare Database
Option Explicit
Public Function SpeciesSearch()
'
**************************************************************************************
' Function Name: SpeciesSearch()
' Description: Function to carry out a search on the Database for a certain species. Also places the
' Site Name as a label on the map, when active.
' Then write results to AditMap via OLE Links.
' Returns: If True opens AditMap. Else False on failure.
' Fields: GridReference (Location), (Value), (Type), (Label), (Symbol), (Colour), (Size)
' Created by: Nigel C. Clemons
' Date Created: 31/10/2002
' Last Modified: 04/11/2002
' Issue: 1.1
' BUG:
' BUG Status:
'
***************************************************************************************
On Error GoTo Err_SpeciesSearch
'Declare local variables
Dim strFind As String
Dim strCounty As String
Dim strSpecies As String
Dim varBookmark As Variant
Dim dbCurrent As DATABASE
Dim rsOrders As Recordset
Dim Text1 As Variant
Dim MapLink As Object
Dim WorkFlag As Long
'Get species and county values.
strCounty = Forms![frmAditMapSpecies]![County]
strSpecies = Forms![frmAditMapSpecies]![Species]
'Create the find string.
strFind = "[Species] = " & Chr$(34) & strSpecies & Chr$(34) & " And [County] = " & Chr$(34) & strCounty & Chr$(34)
Set dbCurrent = DBEngine(0)(0)
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords]")
Set MapLink = CreateObject("AditMap.MapLink") ' Create The Mapping Link.
MapLink.MapLinkPath = "C:\Database\ADITMAP\WarwickD.AMF" ' The path to the Base Map to be used.
WorkFlag = MapLink.LoadLinkMap() ' Load the Base Map.
WorkFlag = MapLink.SetLinkData(1000) ' Allocate rows in Data Editor.
MapLink.MapDataSymbol = "+" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 4 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
MapLink.MapDataSize = 8 ' Numeric Font Size 8 To 64.
WorkFlag = MapLink.AddLinkGrid(1) ' 0=Screen CM, 1=Map 1km, 2=Map 2km, 3=Map 5km, etc as menu on screen
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strFind & ".", 32, "Find Record"
Exit Function
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
'MapLink.MapDataLabel = rsOrders("SiteName") ' Set Label to Site Name of Grid Reference.
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
SpeciesSearch = True ' Prove that the bookmark worked.
End If
WorkFlag = MapLink.DisplayLinkData() ' Display the passed data on the current map.
Exit_SpeciesSearch:
Exit Function
Err_SpeciesSearch:
MsgBox Error$
Resume Exit_SpeciesSearch
End Function
Public Function GridReferenceSearch() As Integer
'
********************************************************************************
' Function Name: GridReferenceSearch()
' Description: Function to search Database for certain species within a specified OS Grid Reference square.
' Returns: If True opens AditMap. Else False on failure.
' Created by: Nigel C. Clemons
' Date Created: 31/10/2002
' Last Modified: 04/11/2002
' Issue: 1.1
' Bug:
'
*********************************************************************************
On Error GoTo Err_GridReferenceSearch
'Declare local variables
Dim varBookmark As Variant
Dim strFind As String
Dim tblname As String
Dim SW As String
Dim SE As String
Dim NW As String
Dim NE As String
Dim strA As String
Dim strSpecies As String
Dim SWRef As String
Dim SERef As String
Dim NWRef As String
Dim NERef As String
Dim strB As String
Dim KMRef As String
Dim X As String
Dim Text1 As Variant
Dim MapLink As Object
Dim WorkFlag As Long
'Get Grid Reference, Species values from Form frmAditMapGridRef.
SW = Forms![frmAditMapGridRef]![SWRef]
SE = Forms![frmAditMapGridRef]![SERef]
NW = Forms![frmAditMapGridRef]![NWRef]
NE = Forms![frmAditMapGridRef]![NERef]
strA = Forms![frmAditMapGridRef]![Species]
strSpecies = UCase(strA) ' Convert to Uppercase.
SWRef = Mid$(SW, 3, 3) ' Place 1st 3 digits of SW into SWRef
SERef = Mid$(SE, 3, 3) ' Place 1st 3 digits of SE into SERef
NWRef = Right$(SW, 3) ' Place last 3 digits of SW into NWRef
NERef = Right$(NE, 3) ' Place last 3 digits of NE into NERef
strB = Left$(SW, 2) ' Get 100Km Ref
KMRef = UCase(strB) ' Convert to Uppercase
strFind = "[Species] = " & Chr$(34) & strSpecies & Chr$(34) ' Create the find string.
'Declare and set object variables
Dim dbCurrent As DATABASE
Dim rsOrders As Recordset
Set dbCurrent = DBEngine(0)(0)
'***********************************************************************
' The following IF statement first checks the 100Km references a$ and ff$.
' Then it checks to see if gr1$ greater than or equal to x1$
' And if gr1$ is less than or equal to x2$.
' Then it checks to see if gr2$ greater than or equal to y1$
' And if gr2$ is less than or equal to y2$.
'
' If ((((a$ = ff$) And (gr1$ >= x1$ And gr1$ <= x2$) And (gr2$ >= y1$ And gr2$ <= y2$)))) Then
'***********************************************************************
'***********************************************************************
' Run the SQL query and place results in tblTempQuery.
' The SQL is as follows:-
' ("SELECT * INTO tblTempQuery
' FROM [tblRecords]
' WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ")
' And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & "
' And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ")
' And (Right([GridReference],3)) >= " & Chr$(34) & NWRef & Chr$(34) & "
' And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34))
'**************************************************************************************
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34))
Set MapLink = CreateObject("AditMap.MapLink") ' Create The Mapping Link.
MapLink.MapLinkPath = "C:\Database\ADITMAP\WarwickD.AMF" ' The path to the Base Map to be used.
WorkFlag = MapLink.LoadLinkMap() ' Load the Base Map.
WorkFlag = MapLink.SetLinkData(1000) ' Allocate rows in Data Editor.
MapLink.MapDataSymbol = "+" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 4 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
MapLink.MapDataSize = 8 ' Numeric Font Size 8 To 64.
WorkFlag = MapLink.AddLinkGrid(1) ' 0=Screen CM, 1=Map 1km, 2=Map 2km, 3=Map 5km, etc as menu on screen
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strFind & ".", 32, "Find Record"
Exit Function
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
GridReferenceSearch = True ' Prove that the bookmark worked.
End If
WorkFlag = MapLink.DisplayLinkData() ' Display the passed data on the current map.
Exit_GridReferenceSearch:
Exit Function
Err_GridReferenceSearch:
MsgBox Error$
Resume Exit_GridReferenceSearch
End Function
Public Function CountyDateSpecies() As Integer
' *********************************************************************************
' Function Name: CountyDateSpecies()
' Description: Function to carry out a search on the Database for a certain
' County and Species within a specified date range.
' Returns: If True opens AditMap. Else False on failure.
' Created by: Nigel C. Clemons
' Date Created: 01/11/2002
' Last Modified: 04/11/2002
' Issue: 1.1
' Bug:
' *********************************************************************************
On Error GoTo Err_CountyDateSpecies
'Declare local variables
Dim varBookmark As Variant
Dim varDateBeg As String
Dim varDateEnd As String
Dim strFind As String
Dim strA As String
Dim strCounty As String
Dim strSpecies As String
Dim X As String
Dim Text1 As Variant
Dim MapLink As Object
Dim WorkFlag As Long
'Get date and species values.
varDateBeg = Forms![frmAditMapDate]![StartDate]
varDateEnd = Forms![frmAditMapDate]![EndDate]
strA = Forms![frmAditMapDate]![Species]
strCounty = Forms![frmAditMapDate]![County]
strSpecies = UCase(strA)
'Create the find string. The next line work's
strFind = "[Date] Between #" & varDateBeg & "# And #" & varDateEnd & "# And [Species] = " & Chr$(34) & strSpecies & Chr$(34) & " And [County] = " & Chr$(34) & strCounty & Chr$(34)
'Declare and set object variables
Dim dbCurrent As DATABASE
Dim rsOrders As Recordset
Set dbCurrent = DBEngine(0)(0)
'**************************************************************************************
'Set rsOrders = dbCurrent.OpenRecordset("
'SELECT [Date], [GridReference], [County], [Species] FROM [tblRecords]
'WHERE [tblRecords].[Species] = " & Chr$(34) & strSpecies$ & Chr$(34) & "
'ORDER BY [Date]")
'**************************************************************************************
Set rsOrders = dbCurrent.OpenRecordset("SELECT [Date], [GridReference], [County], [Species] FROM [tblRecords] WHERE [tblRecords].[Species] = " & Chr$(34) & strSpecies$ & Chr$(34) & " ORDER BY [Date]")
Set MapLink = CreateObject("AditMap.MapLink") ' Create The Mapping Link.
MapLink.MapLinkPath = "C:\Database\ADITMAP\WarwickD.AMF" ' The path to the Base Map to be used.
WorkFlag = MapLink.LoadLinkMap() ' Load the Base Map.
WorkFlag = MapLink.SetLinkData(1000) ' Allocate rows in Data Editor.
MapLink.MapDataSymbol = "+" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 4 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
MapLink.MapDataSize = 8 ' Numeric Font Size 8 To 64.
WorkFlag = MapLink.AddLinkGrid(1) ' 0=Screen CM, 1=Map 1km, 2=Map 2km, 3=Map 5km, etc as menu on screen
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strFind & ".", 32, "Find Record"
Exit Function
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
CountyDateSpecies = True ' Prove that the bookmark worked.
End If
WorkFlag = MapLink.DisplayLinkData() ' Display the passed data on the current map.
Exit_CountyDateSpecies:
Exit Function
Err_CountyDateSpecies:
MsgBox Error$
Resume Exit_CountyDateSpecies
End Function
Public Function AllSpeciesGridSquare() As Integer
'
***************************************************************
' Function Name: AllSpeciesGridSquare()
' Description: Function to carry out a search on the Database for all Species within
' a specified Grid Reference Square.
' Returns: If True opens AditMap. Else False on failure.
' Created by: Nigel C. Clemons
' Date Created: 08/12/2002
' Last Modified: 17/12/2002
' Issue: 2.0
' Bug:
'
****************************************************************
On Error GoTo Err_AllSpeciesGridSquare
'Declare local variables
Dim varBookmark As Variant
Dim strFind As String, tblname As String
Dim SW As String, SE As String, NW As String, NE As String
Dim SWRef As String, SERef As String, NWRef As String, NERef As String
Dim strB As String, KMRef As String, X As String
Dim Text1 As Variant
Dim MapLink As Object
Dim WorkFlag As Long
Dim strAF As String, strBB As String, strLV As String, strNN As String
Dim strRT As String, strTC As String, strTV As String, strVB As String
strAF = "AF"
strBB = "BB"
strLV = "LV"
strNN = "NN"
strRT = "RT"
strTC = "TC"
strTV = "TV"
strVB = "VB"
'Get Grid Reference, Species values from Form frmAditMapSpeciesGridRef.
SW = Forms![frmAditMapSpeciesGridRef]![SWRef]
SE = Forms![frmAditMapSpeciesGridRef]![SERef]
NW = Forms![frmAditMapSpeciesGridRef]![NWRef]
NE = Forms![frmAditMapSpeciesGridRef]![NERef]
SWRef = Mid$(SW, 3, 3) ' Place 1st 3 digits of SW into SWRef
SERef = Mid$(SE, 3, 3) ' Place 1st 3 digits of SE into SERef
NWRef = Right$(SW, 3) ' Place last 3 digits of SW into NWRef
NERef = Right$(NE, 3) ' Place last 3 digits of NE into NERef
strB = Left$(SW, 2) ' Get 100Km Ref
KMRef = UCase(strB) ' Convert to Uppercase
' Create the find string. Gets 100Km Reference.
strFind = "(Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34)
'Declare and set object variables
Dim dbCurrent As DATABASE
Dim rsOrders As Recordset
Set dbCurrent = DBEngine(0)(0)
Set MapLink = CreateObject("AditMap.MapLink") ' Create The Mapping Link.
MapLink.MapLinkPath = "C:\Database\ADITMAP\WarwickD.AMF" ' The path to the Base Map to be used.
WorkFlag = MapLink.LoadLinkMap() ' Load the Base Map.
WorkFlag = MapLink.SetLinkData(1000) ' Allocate rows in Data Editor.
MapLink.MapDataSize = 8 ' Numeric Font Size 8 To 64.
WorkFlag = MapLink.AddLinkGrid(1) ' 0=Screen CM, 1=Map 1km, 2=Map 2km, 3=Map 5km, etc as menu on screen
' Find all Slow worm (Anguis fragilis) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strAF & Chr$(34) & ")")
MapLink.MapDataSymbol = "a" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 1 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strAF & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
' Find all Common Toad (Bufo bufo) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strBB & Chr$(34) & ")")
MapLink.MapDataSymbol = "b" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 2 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strBB & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
' Find all Common Lizard (Lacerta vivipara) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strLV & Chr$(34) & ")")
MapLink.MapDataSymbol = "l" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 3 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strLV & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
' Find all Grass Snake (Natrix natrix) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strNN & Chr$(34) & ")")
MapLink.MapDataSymbol = "n" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 4 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strNN & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
' Find all Common frog (Rana temporaria) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strRT & Chr$(34) & ")")
MapLink.MapDataSymbol = "r" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 5 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strRT & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
' Find all Great Crested Newt (Triturus cristatus) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strTC & Chr$(34) & ")")
MapLink.MapDataSymbol = "c" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 6 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strTC & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
' Find all Common or Smooth Newt (Triturus vulgaris) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strTV & Chr$(34) & ")")
MapLink.MapDataSymbol = "t" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 7 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strTV & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
' Find all Adder (Vipera berus) records.
Set rsOrders = dbCurrent.OpenRecordset("SELECT * FROM [tblRecords] WHERE ((Left([GridReference],2)) = " & Chr$(34) & KMRef & Chr$(34) & ") And ((Mid([GridReference],3,3)) >= " & Chr$(34) & SWRef & Chr$(34) & " And (Mid([GridReference],3,3)) <= " & Chr$(34) & SERef & Chr$(34) & ") And (Right([GridReference],3)) >= " & Chr$(34) & NWRef$ & Chr$(34) & " And (Right([GridReference],3)) <= " & Chr$(34) & NERef & Chr$(34) & " And ([Species] = " & Chr$(34) & strVB & Chr$(34) & ")")
MapLink.MapDataSymbol = "v" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 8 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strVB & ".", 32, "Find Record"
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AllSpeciesGridSquare = True ' Prove that the bookmark worked.
End If
WorkFlag = MapLink.DisplayLinkData() ' Display the passed data on the current map.
Exit_AllSpeciesGridSquare:
Exit Function
Err_AllSpeciesGridSquare:
MsgBox Error$
Resume Exit_AllSpeciesGridSquare
End Function
Public Function AditSiteSearch() As Integer
'
***********************************************************************
' Function Name: AditSiteSearch()
' Description: Function to search Database for certain Site Name.
' Returns: If True opens AditMap. Else False on failure.
' Created by: Nigel C. Clemons
' Date Created: 16/12/2002
' Last Modified: 11/02/2003
' Issue: 1.1
' Bug: Function name changed from SiteSearch as this conflicted with the Excel search Function
' with the same name.
'
************************************************************************
On Error GoTo Err_AditSiteSearch
'Declare local variables
Dim varBookmark As Variant, strFind As String, tblname As String, strA As String
Dim strSite As String, strCounty As String, X As String
Dim Text1 As Variant
Dim MapLink As Object
Dim WorkFlag As Long
'Get Site Name value.
'strSite = Forms![frmDmapSiteSearch]![SiteName]
strSite = "Ufton Fields"
'Create the find string
strFind = "[SiteName] = " & Chr$(34) & strSite & Chr$(34)
'Declare and set object variables
Dim dbCurrent As DATABASE
Dim rsOrders As Recordset
Set dbCurrent = DBEngine(0)(0)
'
*******************************************************************************
' SELECT tblSites.SiteName, tblRecords.GridReference, tblRecords.Species
' FROM tblRecords INNER JOIN tblSites ON tblRecords.SiteName = tblSites.SiteName
' WHERE ((tblSites.SiteName) Like "Kenilworth Common"));
'
*******************************************************************************
Set rsOrders = dbCurrent.OpenRecordset("SELECT tblSites.SiteName, tblRecords.GridReference, tblRecords.Species FROM tblRecords INNER JOIN tblSites ON tblRecords.SiteName = tblSites.SiteName WHERE ((tblSites.SiteName) = " & Chr$(34) & strSite & Chr$(34) & ")")
Set MapLink = CreateObject("AditMap.MapLink") ' Create The Mapping Link.
MapLink.MapLinkPath = "C:\Database\ADITMAP\WarwickD.AMF" ' The path to the Base Map to be used.
WorkFlag = MapLink.LoadLinkMap() ' Load the Base Map.
WorkFlag = MapLink.SetLinkData(1000) ' Allocate rows in Data Editor.
MapLink.MapDataSymbol = "+" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 4 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
MapLink.MapDataSize = 8 ' Numeric Font Size 8 To 64.
WorkFlag = MapLink.AddLinkGrid(1) ' 0=Screen CM, 1=Map 1km, 2=Map 2km, 3=Map 5km, etc as menu on screen
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strFind & ".", 32, "Find Record"
Exit Function
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
AditSiteSearch = True ' Prove that the bookmark worked.
End If
WorkFlag = MapLink.DisplayLinkData() ' Display the passed data on the current map.
Exit_AditSiteSearch:
Exit Function
Err_AditSiteSearch:
MsgBox Error$
Resume Exit_AditSiteSearch
End Function
Public Function Adit_10K() As Integer
'
**********************************************************************
' Function Name: Adit_10K()
' Description: Function to search Database for all species in a 10Km square.
' Returns: If True opens AditMap. Else False on failure.
' Created by: Nigel C. Clemons
' Date Created: 14/02/2003
' Last Modified:
' Issue: 1.0
' Bug:
'
**************************************************************************
On Error GoTo Err_Adit_10K
'Declare local variables
Dim varBookmark As Variant, strFind As String, tblname As String, strA As String
Dim strSquare As String, strCounty As String, X As String
Dim Text1 As Variant
Dim MapLink As Object
Dim WorkFlag As Long
'Get Site Name value.
'strSite = Forms![frmAdit_10K]![10KmSquare]
strSquare = "15"
'Create the find string
strFind = "[10KmSquare] = " & Chr$(34) & strSquare & Chr$(34)
'Declare and set object variables
Dim dbCurrent As DATABASE
Dim rsOrders As Recordset
Set dbCurrent = DBEngine(0)(0)
'***************************************************************************
'Set rsOrders = dbCurrent.OpenRecordset("
'SELECT [Date], [GridReference], [County], [10KmSquare] FROM [tblRecords]
'WHERE [tblRecords].[10KmSquare] = " & Chr$(34) & SearchSquare & Chr$(34) & "
'ORDER BY [Date]")
'**************************************************************************
Set rsOrders = dbCurrent.OpenRecordset("SELECT [Date], [GridReference], [County], [10KmSquare] FROM [tblRecords] WHERE [tblRecords].[10KmSquare] = " & Chr$(34) & strSquare & Chr$(34) & " ORDER BY [Date]")
Set MapLink = CreateObject("AditMap.MapLink") ' Create The Mapping Link.
MapLink.MapLinkPath = "C:\Database\ADITMAP\WarwickD.AMF" ' The path to the Base Map to be used.
WorkFlag = MapLink.LoadLinkMap() ' Load the Base Map.
WorkFlag = MapLink.SetLinkData(1000) ' Allocate rows in Data Editor.
MapLink.MapDataSymbol = "+" ' Character In Range Asc(33 To 126).
MapLink.MapDataColour = 4 ' Numeric 0 To 15 (1=Blue, 2=Green, 3=Cyan, 4=Red).
MapLink.MapDataSize = 8 ' Numeric Font Size 8 To 64.
WorkFlag = MapLink.AddLinkGrid(1) ' 0=Screen CM, 1=Map 1km, 2=Map 2km, 3=Map 5km, etc as menu on screen
rsOrders.FindFirst strFind ' Find first record.
If rsOrders.NoMatch Then
MsgBox "No entries found for '" & strFind & ".", 32, "Find Record"
Exit Function
Else
varBookmark = rsOrders.Bookmark ' Set the bookmark to the first record found.
Do While Not rsOrders.NoMatch ' Send the first and succeeding values to AditMap.
Text1 = rsOrders("GridReference")
WorkFlag = MapLink.PlotLinkData(Text1)
rsOrders.FindNext strFind
DoEvents
Loop
rsOrders.Bookmark = varBookmark
Adit_10K = True ' Prove that the bookmark worked.
End If
WorkFlag = MapLink.DisplayLinkData() ' Display the passed data on the current map.
Exit_Adit_10K:
Exit Function
Err_Adit_10K:
MsgBox Error$
Resume Exit_Adit_10K
End Function
|
