esskaykay said:
Of course. My fault...
I have a query for other items.
SKK
First the modules
1) Module Name Address Break Down
Option Compare Database
Function ReplaceQ(pString1 As String, pFind As String, pReplacement As String) As String
ReplaceQ = Replace(pString1, pFind, pReplacement)
End Function
2) Module Name MOD_Siteline
Option Compare Database
Option Explicit
Public Function SiteLine(strSite As String, intLine) As String
Dim strLine(4) As String, lngLoop As Long
Dim lngFirstComma As Long, lngLastComma As Long
On Error GoTo TextError
lngLoop = 1
Do
lngLastComma = InStr(strSite, ",")
If lngLastComma = 0 Then lngLastComma = Len(strSite)
strLine(lngLoop) = Left$(strSite, lngLastComma)
strSite = Right$(strSite, Len(strSite) - Len(strLine(lngLoop)))
lngLoop = lngLoop + 1
Loop Until lngLoop = 4 Or Len(strSite) < 1
strLine(lngLoop) = strSite
If Left$(strLine(intLine), 1) = " " Then
SiteLine = Right$(strLine(intLine), Len(strLine(intLine)) - 1)
Else
SiteLine = strLine(intLine)
End If
Exit Function
TextError:
SiteLine = ""
End Function
Public Function FullLocation(lngLocationID As Long) As String
Dim dbs As Database, rstLocations As Recordset
On Error GoTo NoLocation
Set dbs = CurrentDb
FullLocation = RecurseLocation(lngLocationID, dbs)
NoLocation:
End Function
Public Function RecurseLocation(lngLocationID As Long, dbs As Database) As String
Dim strLocation As String, lngParentID As Long
On Error GoTo NullLocation
strLocation = DLookup("Label", "Locations", "LocationID =" & lngLocationID)
lngParentID = DLookup("ParentID", "Locations", "LocationID =" & lngLocationID)
If lngParentID > 1 Then
strLocation = strLocation & ", " & RecurseLocation(lngParentID, dbs)
Else
strLocation = strLocation & "."
End If
RecurseLocation = strLocation
Exit Function
NullLocation:
RecurseLocation = ""
End Function
3) Module Name tbExtractStringFunctions
Option Compare Database 'Use database order for string comparisons
Function tbExtractStr(strIn, intNeedSegment, strDelimiter, Optional strNotFound As String) As String
' Function to chop a input string into segments and return the requested segment
' Written and developed by Thomas M. Brittell
' Copyright 1998; All rights reserved.
'
' strIn - Input string to be segmented
' intNeedSegment - Indicates the segment to be returned
' strDelimiter - The delimiter used to seperate each segment
' strNotFound - When no segment is found return the specified string if provided
'
Dim intCurrentPosition As Integer
Dim intFoundPosition As Integer
Dim intLastPosition As Integer
Dim intGetSegment As Integer
Dim wrkNotFound As String
If IsEmpty(strNotFound) Or strNotFound = "" Then
wrkNotFound = ""
Else
wrkNotFound = strNotFound
End If
intCurrentPosition = 0
intFoundPosition = 0
intLastPosition = 0
intGetSegment = intNeedSegment
Do While intGetSegment > 0
intLastPosition = intCurrentPosition
'Find a occurance of the delimiter
intFoundPosition = InStr(intCurrentPosition + 1, strIn, Left$(strDelimiter, 1))
If intFoundPosition > 0 Then
intCurrentPosition = intFoundPosition
intGetSegment = intGetSegment - 1
Else
'End of input string so exit
intCurrentPosition = Len(strIn) + 1
Exit Do
End If
Loop
'If nothing was found and you had at least one delimiter return ""
If (intFoundPosition = 0) And ((intGetSegment <> intNeedSegment) And (intGetSegment > 1)) Then
tbExtractStr = wrkNotFound
Else
'Return the segment between the last position and the current one
tbExtractStr = Mid$(strIn, intLastPosition + 1, intCurrentPosition - intLastPosition - 1)
End If
End Function
---------------------------------------------------------------------------
You will need to design a query to call the modules use the following line
Name1: tbExtractStr([Address],[intSegment1],", ","Nothing Found")
This will take the first section ie "1234"
then by moving the "intsegment" on one number it will do other parts of your address.
Hope this helps you.
Alastair
