split string into parts but...

[lala]

Hi, i'm working on a database that transfers data from Access to Quickbooks.
here's the problem, instead of having one long field for Company name, another long field for Address (not including City, State and ZIP) they have Company name field 41 chars long and 6 address fields 41 chars long.

so what they usually do in QB if the company is longer than 41 chars - type the company name in the address box. in QB, the address box looks like one big box (see attachment). so they can type up to 6 lines (41 chars each), so a company can take 3 lines and the address another 3, or a company can take 1 line and an address 2 lines. In the background tables there're 6 address fields 41 chars each. i hope i'm not confusing everyone.


so i have multiple problems. first of all, how to split up company names and addresses at the very least by a space, so the words don't get cut off.

and second, how do i know which line to start the address on for every customer? i have an idea on what has to be done, just don't know how to do it.

thank you

 

[Uncle Gizmo]

how to split up company names and addresses at the very least by a space,

Search this forum for information on "parsing" or " parsing data" there should be a link at the bottom of my post which will help you focus your search within this forum.

 

[lala]

thank you very much, i found it
in case someone needs it, this works perfect.
and here's the thread
http://www.access-programmers.co.uk/forums/newreply.php?do=postreply&t=215372

Here's a functions for you that will do the split:

Public Function getField(inputString As String, FieldNo As Integer, FieldSize As Integer) As String
Dim intBreakPoint As Integer
Dim strW As String
Dim i As Integer

strW = inputString
For i = 1 To FieldNo
    strW = LTrim(strW)
    If Len(strW) > FieldSize Then
        intBreakPoint = InStrRev(Left(strW, FieldSize + 1), " ")
        getField = Left(strW, intBreakPoint - 1)
        strW = Right(strW, Len(strW) - intBreakPoint)
    Else
        getField = strW
    End If
Next i

End Function

So we run the function like this:

getField(input string, number of field we are after, max size of field)

So suppose we test with this (note that the test string is only 116 characters):

strTest = "Lorem ipsum dolor sit ammet, consectetuer adipiscing elit. Maecenas porttitor congue massa. Fusce posuere, magna sed"
Debug.Print getField(strTest, 1, 40)
Debug.Print getField(strTest, 2, 40)
Debug.Print getField(strTest, 3, 40)

the output is:
Lorem ipsum dolor sit ammet,
consectetuer adipiscing elit. Maecenas
porttitor congue massa. Fusce posuere,

So the function I wrote has done the job according to your rules. However, there is still more text to come. Your rules have meant that we can't squeeze the text into 3x40char fields.

Hope you see the that the problem is not with the code but with what you are trying to do.

Chris

 

[lala]

and another tweek that i need for this code. i have a very ugly way of doing it in mind, but figured i might ask and learn something again from here

Public Function getField(inputString As String, FieldNo As Integer, FieldSize As Integer) As String
Dim intBreakPoint As Integer
Dim strW As String
Dim i As Integer

strW = inputString
For i = 1 To FieldNo
    strW = LTrim(strW)
    If Len(strW) > FieldSize Then
[B][COLOR="Red"]        intBreakPoint = InStrRev(Left(strW, FieldSize + 1), " ")[/COLOR][/B]        
getField = Left(strW, intBreakPoint - 1)
        strW = Right(strW, Len(strW) - intBreakPoint)
    Else
        getField = strW
    End If
Next i

End Function

how do i get this code to separate not by a space only but whatever is closest to the 41st character, like all these

const CHARS = " .!?,;:""'()[]{}"

thank you!!

 

[lala]

no, i can't do it the ugly way either, overestimated myself

can someone help? it's not THAT important but if it's something easy and someone has a minute i'd appreciate it

thank you

 

[jdraw]

I had to adjust the GetField function, I found some issues.
Here is another version and a ClosestChar function to deal with your other "triggers"
I've included a test routine. Give it a try and post back.

Public Function getField(inputString As String, _
FieldNo As Integer, _
fieldsize As Integer) As String

Dim intBreakPoint As Integer
Dim strW As String
Dim i As Integer

10 On Error GoTo getField_Error

20 strW = inputString
30 For i = 1 To FieldNo
40 strW = LTrim(strW)
50 If Len(strW) > fieldsize Then
60 intBreakPoint = InStrRev(Left(strW, fieldsize + 1), closestChar(strW, fieldsize))
70 If intBreakPoint = 0 Then
80 getField = Left(strW, fieldsize)
90 strW = Trim(Mid(strW, fieldsize + 1))
100 Else
110 getField = Left(strW, intBreakPoint - 1)
120 strW = Trim(Right(strW, Len(strW) - intBreakPoint))
130 End If
140 Else
150 getField = strW
160 GoTo GetOUT
170 End If
180 Next i
GetOUT:
190 On Error GoTo 0
200 Exit Function

getField_Error:

210 MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure getField of Module Module4 at line " & erl

End Function

Function closestChar(s As String, fieldsize As Integer) As String
Const CHARS = " .!?,;:""'()[]{}"
Dim strtest As String
Dim MyMin As Integer
On Error GoTo closestChar_Error

10 MyMin = 0
Dim chkchar As String, i as Integer
20 For i = 1 To 15
30 chkchar = Mid(CHARS, i, 1)
40 If InStr(s, chkchar) = 0 Then GoTo Loop1
50 If (InStr(s, chkchar) > MyMin) And (InStr(s, chkchar) < fieldsize) Then
60 MyMin = InStr(s, chkchar)
70 If MyMin < fieldsize Then closestChar = chkchar
80 End If
Loop1:
90 Next i

On Error GoTo 0
Exit Function

closestChar_Error:

MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure closestChar of Module Module4 at line " & Erl
End Function

Sub Dec2TEST()
Dim strtest As String
strtest = "Big Bad Commercial Company Inc.,2345 El Celindrical Boul?, San Washington Place -(234),Lake Worth, FL 33461"
Debug.Print getField(strtest, 1, 36)
Debug.Print getField(strtest, 2, 36)
Debug.Print getField(strtest, 3, 36)
Debug.Print getField(strtest, 4, 36)
End Sub

You can try different line sizes.

 

[lala]

wow!!!!! of course it worked, not that i doubted)))))))

in case someone else needs it in the future,

Dim i As Integer

is missing from the ClosestChar function


thank you so much!!!!!!!!!!!!!1

 

[lala]

sorry, problem, look what happens



if there's only enough text for one field

Sub Dec2TEST()
Dim strtest As String
strtest = "Big Bad Commercial Compa"
Debug.Print getField(strtest, 1, 36)
Debug.Print getField(strtest, 2, 36)
Debug.Print getField(strtest, 3, 36)
Debug.Print getField(strtest, 4, 36)
End Sub

Big Bad Commercial Compa
Big Bad Commercial Compa
Big Bad Commercial Compa
Big Bad Commercial Compa

if there's only enough text for 2 fields

Sub Dec2TEST()
Dim strtest As String
strtest = "Big Bad Commercial Company enough space for 2 fields only"
Debug.Print getField(strtest, 1, 36)
Debug.Print getField(strtest, 2, 36)
Debug.Print getField(strtest, 3, 36)
Debug.Print getField(strtest, 4, 36)
End Sub

Big Bad Commercial Company enough
space for 2 fields only
space for 2 fields only
space for 2 fields only

i'm sorry, i'm not being lazy but this is urgent and i don't have time to learn as i usually do. and i'm not a coder that can look at this code and pick up what's wrong right away

 

[lala]

hey, in case anyone needs it, i think i got it

it's an ugly solution and i'm sure it could've been done much more elegant so if someone has a minute whenever - i'd love to see how they'd do it so i can compare it to what i did and learn something

Public Function getField(inputString As String, FieldNo As Integer, FieldSize As Integer) As String

Dim intBreakPoint As Integer
Dim strW As String
Dim i As Integer
[COLOR="Blue"]Dim StartAt As Integer[/COLOR]


On Error GoTo getField_Error

[COLOR="blue"]StartAt = 1[/COLOR]
strW = inputString
                  For i = 1 To FieldNo
                  [COLOR="blue"]strW = LTrim(Mid(strW, StartAt))[/COLOR]                           

                           If Len(strW) > FieldSize Then
                           intBreakPoint = InStrRev(Left(strW, FieldSize + 1), closestChar(strW, FieldSize))
                                    If intBreakPoint = 0 Then 'the first 46 charc are pasted
                                    getField = Left(strW, FieldSize)
                                    [COLOR="blue"]StartAt = StartAt + (FieldSize - 1)[/COLOR]                                    
                                    Else
                                    getField = Left(strW, intBreakPoint - 1)
                                    [COLOR="blue"]StartAt = StartAt + (intBreakPoint - 1)[/COLOR]                                     
                                    End If
                           [COLOR="blue"]ElseIf Len(strW) < FieldSize Then[/COLOR]                           
                           getField = strW
                           [COLOR="blue"]StartAt = StartAt + Len(strW)[/COLOR]                            
                           [COLOR="blue"]ElseIf Len(strW) = 0 Then
                           getField = ""[/COLOR]  
                           GoTo GetOUT
                           End If
                  Next i
GetOUT:
On Error GoTo 0
Exit Function

getField_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure getField of Module Module4 at line & erl"


End Function

 

[jdraw]

Here are some revisions:

A revised GetField function; same ClosestChar function, and a more detailed Test program that allows variable size parameters and calculates array dimension accordingly.

'---------------------------------------------------------------------------------------
' Procedure : getfield
' Author : JDraw
' Date : 05-12-2011
' Purpose : This routine has been updated to NOT drop the line terminating
'character whatever that character may be (see ClosestChar function for characters)
'
' Also, the logic of this routine was changed to return an empty string in those
'cases where the FieldNo requested was greater than the last parsed text fragment.
'
'For example: If the parsing based on input and fieldSize results in 5 fields, then
' requesting fragment 6 or 7 will return an empty string.
'
'Previously, these requests returned the value of the 5th fragment.
'---------------------------------------------------------------------------------------
' Last Modified: 5-12-2011
'
' Inputs:
' inputString As String ( the source text string)
' FieldNo As Integer (the fragment to return)
' FieldSize as Integer (the nominal fragment size)
'
' Dependency: ClosestChar() function
'--------------------------------------------------------------------------
'
Public Function getfield(inputString As String, _
FieldNo As Integer, _
FieldSize As Integer) As String

'adjusted to not drop the line ending character whatever it may be
'adjusted to return empty string if no fragment at FieldNo exists

Dim intBreakPoint As Integer
Dim strW As String
Dim i As Integer

10 On Error GoTo getfield_Error

20 strW = inputString
30 For i = 1 To FieldNo
40 strW = LTrim(strW)
50 If Len(strW) > FieldSize Then
60 intBreakPoint = InStrRev(Left(strW, FieldSize + 1), closestChar(strW, FieldSize))
70 If intBreakPoint = 0 Then
80 getfield = Left(strW, FieldSize)
90 strW = Trim(Mid(strW, FieldSize + 1))
100 Else
110 getfield = Left(strW, intBreakPoint) '-1 jdraw removed
120 strW = Trim(Right(strW, Len(strW) - intBreakPoint))
130 End If
140 Else
'
'********************** Added logic required to output requested FieldNo
150 If i = FieldNo Then
160 getfield = strW
170 Else
180 getfield = ""
190 End If
'*********************
200 GoTo GetOUT
210 End If
220 Next i
GetOUT:
230 On Error GoTo 0
240 Exit Function

getfield_Error:

250 MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure getfield of Module Module4 at line & erl"

End Function

Function closestChar(s As String, FieldSize As Integer) As String
Const CHARS = " .!?,;:""'()[]{}"
Dim strtest As String
Dim MyMin As Integer
10 On Error GoTo closestChar_Error

20 MyMin = 0
Dim chkchar As String
30 For i = 1 To 15
40 chkchar = Mid(CHARS, i, 1)
50 If InStr(s, chkchar) = 0 Then GoTo Loop1
60 If (InStr(s, chkchar) > MyMin) And (InStr(s, chkchar) < FieldSize) Then
70 MyMin = InStr(s, chkchar)
80 If MyMin < FieldSize Then
90 closestChar = chkchar
100 End If
110 End If
Loop1:
120 Next i

130 On Error GoTo 0
140 Exit Function

closestChar_Error:

150 MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure closestChar of Module Module4 at line " & Erl
End Function

' Procedure : Dec2TEST
' Author : JDraw
' Date : 05-12-2011
' Purpose : This is a test routine that uses the
' --GetField function and
' --ClosestChar function
' This test routine accepts a user entered Fieldsz parameter with default of 40.
' It uses the called functions to get the text fragments based on the Fieldsz
' and the various line terminating characters. This routine puts the results
' in an array and checks the contents.
'
' Note: The original GetField function will retrieve the text fragment that
' is less than the FieldSz, for any FieldNo equal or greater than the
' FieldNo where such a text fragment was first found.
' For example: Suppose the 5th text fragment was less than the FieldSz.
' If you ask for FieldNo 6 or FieldNo 7. Getfield would return the
' 5th fragment when you request FieldNo 5 or above.
'
'The logic of GETField was adjusted to remove this error. GETField now will
'return an empty string "" if the FieldNo requested is beyond the parsed
' number of fragments.
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: FieldSz (text fragment line size) from user, default is 40
' Dependency: Getfield() and ClosestChar()
'--------------------------------------------------------------------------
'
Sub Dec2TEST()
Dim strtest As String
Dim FieldSz As Integer
Dim x As Integer
Dim i As Integer
Dim a() As String
10 On Error GoTo Dec2TEST_Error

20 strtest = "Big Bad Commercial Company Inc.,The Kentucky-Kansas Conglomerate: 2345 El Celindrical Boul?, San Washington Place -(234),Lake Worth, FL 33461"
30 FieldSz = InputBox("What is the fieldsize for this run", "TESTING", 40)
40 x = (Len(strtest) / FieldSz) + 4 'arbitrary assignment
50 ReDim Preserve a(x)
60 Debug.Print "Parsing of input string based on FieldSz (" & FieldSz & ")"
70 Debug.Print
80 For i = 1 To x
90 a(i) = getfield(strtest, i, FieldSz)
100 Debug.Print i & " **** " & a(i)
110 Next i
120 Debug.Print
130 Debug.Print "--- Results ---"
140 Debug.Print
150 For i = 1 To UBound(a)

160 Debug.Print a(i)

220 Next i

230 On Error GoTo 0
240 Exit Sub

Dec2TEST_Error:

250 MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure Dec2TEST of Module Module4"
End Sub