# Thread: Tricks - Optimization 2

1. Registered User
Join Date
Feb 2004
Location
Irving, TX (Dallas, Fort Worth)
Posts
379

## Unanswered: Tricks - Optimization 2

Since the board is screwed y'day and today I'll add my posts here:

This is the optimized code for WORDPOS:

Code:
```Public Function WordPos(ByVal sSource As String, sTarget As String) As Integer
Dim n As Integer
WordPos = 0
If InStr(1, sSource, sTarget) > 0 Then
For n = 1 To Words(sSource)
If Word(sSource, n) = sTarget Then
WordPos = n
Exit For
End If
Next n
End If
End Function```
You'll have to have the code for WORD and WORDS from thread:

http://www.dbforums.com/t1177520.html

for this to work. This is not possible today as board is hosed and error occur on trying to access it.

DBS4M
Last edited by dbsupport4me; 09-21-05 at 15:15.

2. Registered User
Join Date
Feb 2004
Location
Irving, TX (Dallas, Fort Worth)
Posts
379

## Repost

Since the old thread is no longer viewable, due to problems on the board, I'm reposting the code.

Code:
``` Function JulDat(TheDate As Date) As Integer
JulDat = DateDiff("d", ("12-31-" & Year(TheDate) - 1), TheDate)
End Function

Function FixLine(MyLine As String) As String
FixLine = Replace(MyLine, "'", "`")
End Function

Function Words(sWord As String) As Integer
' Find the Words in the input string <MyWLine> whether
' Blank <" ">, Comma <","> or Blank+Comma <", "> seperated
Dim bCount As Integer, cCount As Integer, bcCount As Integer
Words = 0
If Len(sWord) = 0 Then Exit Function
Words = 1
bCount = UBound(Split(sWord, " ")) + 1
cCount = UBound(Split(sWord, ",")) + 1
bcCount = UBound(Split(sWord, ", ")) + 1
If bcCount > 1 Then
Words = bcCount
ElseIf bCount > 1 Then
Words = bCount
ElseIf cCount > 1 Then
Words = cCount
End If
End Function

Function Word(MyWLine As String, MyIdx As Integer) As String
' Find the nth <MyIdx> Word in the input string <MyWLine>
Dim MyArr1() As String, MyArr2() As String, MyArr3() As String
Word = MyWLine
If Len(MyWLine) > 0 Then
MyArr1 = Split(MyWLine, " ")
MyArr2 = Split(MyWLine, ",")
MyArr3 = Split(MyWLine, ", ")
If MyArr3(0) <> MyWLine Then
Word = MyArr3(MyIdx - 1)
ElseIf MyArr1(0) <> MyWLine Then
Word = MyArr1(MyIdx - 1)
ElseIf MyArr2(0) <> MyWLine Then
Word = MyArr2(MyIdx - 1)
End If
End If
End Function

Function PrsCnt(MyWLine As String, MyChar As String) As Integer
' Find the Words in the input string <MyWLine> when seperated by character <MyChar>
Dim pCount As Integer
PrsCnt = 0
If Len(MyWLine) = 0 Then Exit Function
PrsCnt = 1
pCount = UBound(Split(MyWLine, MyChar)) + 1
If pCount > 1 Then
PrsCnt = pCount
End If
End Function

Function PrsLin(MyWLine As String, MyIdx As Integer, MyChar As String) As String
' Find the nth <MyIdx> Word in the input string <MyWLine>
Dim MyArr() As String
PrsLin = MyWLine
If Len(MyWLine) > 0 Then
MyArr = Split(MyWLine, MyChar)
If MyArr(0) <> MyWLine Then
PrsLin = MyArr(MyIdx - 1)
End If
End If
End Function

Function DoesTblExist(strTblName As String) As Boolean
On Error GoTo Err_Set
Dim db As DAO.Database, SQLstr As String
Set db = CurrentDb
SQLstr = "SELECT * from MSysObjects WHERE ([Name]='" & strTblName & "');"
Set RCs2 = db.OpenRecordset(SQLstr)
RCs2.MoveLast
If RCs2.RecordCount > 0 And Not IsNull(RCs2.RecordCount) Then
DoesTblExist = True
End If
Exit Function

Err_Set:
DoesTblExist = False
End Function

Function delword(sWord As String, dWord As String) As String
Dim lStr As String, rStr As String, CurPos As Integer
CurPos = InStr(1, sWord, dWord)
lStr = Left(sWord, CurPos - 1)
rStr = Mid(sWord, CurPos + Len(dWord) + 1)
delword = RTrim(lStr & rStr)
End Function

Function delwords(sWord As String, sPos As Integer, Optional nWrds As Integer) As String
Dim lStr As String, rStr As String, CurWrd As String, CurPos As Integer, NxtPos As Integer
CurWrd = Word(sWord, sPos)
CurPos = InStr(1, sWord, CurWrd)
lStr = Left(sWord, CurPos + Len(CurWrd))
If IsMissing(nWrds) Then
delword = RTrim(lStr)
Else
CurWrd = Word(sWord, sPos + nWrds)
CurPos = InStr(1, sWord, CurWrd)
rStr = Mid(sWord, CurPos)
delword = lStr & rStr
End If
End Function

Function MixName(MyName As String) As String
Dim DshNum As Integer, BlkNum As Integer, WrdNum As Integer, tmpName As String, n As Integer
Dim ChkChr As String, StrStr As String
MyName = Strip_Dept(MyName)
DshNum = UBound(Split(MyName, "-"))
BlkNum = UBound(Split(MyName, " "))
If DshNum = 0 And BlkNum = 0 Then
MixName = UCase(Left(MyName, 1)) & LCase(Mid(MyName, 2))
End If
If DshNum > 0 And BlkNum = 0 Then ChkChr = "-"
If DshNum = 0 And BlkNum > 0 Then ChkChr = " "
WrdNum = PrsCnt(MyName, ChkChr)
MixName = ""
For n = 1 To WrdNum
tmpName = PrsLin(MyName, n, ChkChr)
If Len(tmpName) > 1 Then
MixName = Trim(MixName & ChkChr & UCase(Left(tmpName, 1)) & LCase(Mid(tmpName, 2)))
Else
MixName = Trim(MixName & ChkChr & UCase(Left(tmpName, 1)))
End If
Next n
If Left(MixName, 1) = "-" Then MixName = Mid(MixName, 2)
End Function

Function WordPos(ByVal sSource As String, sTarget As String) As Integer
Dim n As Integer
WordPos = 0
If InStr(1, sSource, sTarget) > 0 Then
For n = 1 To Words(sSource)
If Word(sSource, n) = sTarget Then
WordPos = n
Exit For
End If
Next n
End If
End Function```
I will list all commands in a later post.

DBS4M

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•