×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Using the StdText object
2

Using the StdText object

Using the StdText object

(OP)
Does anyone have either
- some good documentation, or
- some nice VB code
that explains the StdText object?  The supplied doco is a bit vague and the only sample is in delphi.  We are trying to append extended text to work orders.

Thanks,

Steve

RE: Using the StdText object


Hi Steve

Here is some VBA code I use in MSAccess or MSExcel to handle extended text. You'll need to paste the code into a class module. Hope this helps.

Regards
Dallas



Option Compare Database
Option Explicit

'PURPOSE:
' This class creates extended text entries for any text code/text key on a remove and replace basis.
' Existing text for the code/key combination is removed and replaced with the text string provided.
' The class automatically breaks long text strings in memo type fields into suitable lengths for loading
' to MIMS.

'****************************** CLASS USAGE EXAMPLES ******************************************
'Public Sub UseExtTextClass_Set()
'    Dim myText As clsExtText                               'Create an instance of the class
'    mims_go                                                'Log in to MIMS
'    myText.TextType = "**"                                 'Two character Text Type Code
'    myText.TextID = "000000023320020116ACCO"               'The Text Key
'    myText.Text = "This is the text we want to load."      'The Text
'    If Not myText.MIMS_SetText Then                        'Load the text
'        MsgBox "Error updating text"                       'Handle any errors
'    End If
'    mims_stop                                              'Log out of MIMS
'End Sub

'Public Sub UseExtTextClass_Get()
'    Dim myText As New clsExtText                           'Create an instance of the class
'    Dim someText As String
'    mims_go                                                'Log in to MIMS
'    myText.TextType = "DT"                                 'Two character Text Type Code
'    myText.TextID = "0000100300068153BIPLEL01"             'The Text Key
'    myText.MIMS_Fetch                                      'Get text from MIMS
'    someText = myText.Text
'    MsgBox someText
'    mims_stop                                              'Log out of MIMS
'End Sub
'*********************************************************************************************
Private Const ClassName = "MIMS_StdText"
Private Const aLineLength = 60
Private MIMSlineCount As Long
Private MIMStotalCurrentLines As Long
Public TextType As String
Public TextID As String
Public HeadingLine As String
Private TextLines As Collection
Public errors As New Collection

Private Sub Class_Initialize()
    Set TextLines = New Collection
End Sub

Public Property Get Text() As String
    Dim Line As Variant
    For Each Line In TextLines
        Text = Text & Line & Chr(13) & Chr(10)
    Next Line
End Property

Public Property Let Text(ByVal vNewValue As String)
    Set TextLines = New Collection
    If vNewValue = "" Then
        Exit Property
    End If
    
    Dim newLine As String
    Dim oldLine As String
    Dim pos As Integer
    Dim CRLF As String
    Dim longLines As Collection
    Dim longLine As Variant
    CRLF = Chr(13) & Chr(10)
    
    ' Split the lines from the Memo into the array using CRLF.
    Set longLines = New Collection
    oldLine = vNewValue
    newLine = ""
    While Len(oldLine) > 0
        pos = InStr(oldLine, CRLF)
        If pos = 0 Then
            longLines.Add oldLine
            oldLine = ""
        Else
            longLines.Add Mid(oldLine, 1, pos - 1)
            oldLine = Mid(oldLine, pos + 2, Len(oldLine))
        End If
    Wend
    
    ' Split each line now in the array using LineLength
    For Each longLine In longLines
    
        If Len(longLine) = 0 Then
            TextLines.Add longLine
        Else
            
            oldLine = longLine
            While Len(oldLine) > 0
                If Len(oldLine) <= aLineLength Then
                    TextLines.Add oldLine
                    oldLine = ""
                Else
                    pos = InStr(oldLine, " ")
                    newLine = ""
                    If pos > aLineLength Or pos = 0 Then
                        TextLines.Add Mid(oldLine, 1, aLineLength)
                        oldLine = Mid(oldLine, aLineLength + 1, Len(oldLine))
                    Else
                        While (Len(newLine) + pos - 1) <= aLineLength And pos <> 0
                            newLine = newLine & Mid(oldLine, 1, pos)
                            oldLine = Mid(oldLine, pos + 1, Len(oldLine))
                            pos = InStr(oldLine, " ")
                        Wend
                        TextLines.Add newLine
                    End If
                End If
            Wend
        End If
    
    Next longLine

End Property

Public Function appendText(aString As String)
    Dim myText As String
    myText = Me.Text
    myText = myText & aString
    Me.Text = myText
End Function

Public Function MIMS_SetText() As Boolean
On Error Resume Next

    Dim Block As New MIMSBlock
    Dim Reply As New MIMSReply
    Dim Request As MIMSRequest
    Dim Instance As MIMSInstance
    Dim textLine As Variant
    Dim startLineNo As Long
    Dim lineCount As Long
    Dim totalCurrentLines As Long
    Dim lineIDX As Long
    Dim instanceTextLine As String
    
    Set Block = gobjMIMS.Blocks.New
    Set Request = Block.Requests.New
    Request.AddFieldNameValue MIMSX_FLAG_SERVICE, "STDTEXT.Delete"
    Request.AddFieldNameValue "_BeginTxn", ""
    Request.AddFieldNameValue "_Commit", ""
    Request.AddFieldNameValue "_ErrorControl", 1
    Request.Instances.New (1)
    Request.Instances(1).AddFieldNameValue "StdTextId", TextType & TextID
    
    Set Request = Block.Requests.New
    Request.AddFieldNameValue "_Service", "STDTEXT.SetText"
    Request.AddFieldNameValue "_ReplyList", "StdTextId"
                
    lineIDX = 0
    startLineNo = 1
    totalCurrentLines = TextLines.Count
    instanceTextLine = ""
    lineCount = 0
    
    For Each textLine In TextLines
        lineIDX = lineIDX + 1
        lineCount = lineCount + 1
        instanceTextLine = instanceTextLine & textLine & Space(160 - Len(textLine))
        
        If lineCount = 20 Then ' Create new instance for this batch of 20 lines
            Set Instance = Request.Instances.New
            Instance.AddFieldNameValue "StdTextId", TextType & TextID
            Instance.AddFieldNameValue "StartLineNo", startLineNo             ' Starting line of this instance
            Instance.AddFieldNameValue "LineCount", lineCount                 ' Number of lines in this instance
            Instance.AddFieldNameValue "TotalCurrentLines", totalCurrentLines ' Total number of lines in the Text
            Instance.AddFieldNameValue "TotalRetrievedLines", 0               ' Number of Lines already there
            Instance.AddFieldNameValue "TextLine", instanceTextLine           ' Lines of text
            Instance.AddFieldNameValue "HeadingLine", HeadingLine             ' Dummy Heading Line
            startLineNo = startLineNo + lineCount
            instanceTextLine = ""
            lineCount = 0
        End If
        
    Next textLine
    
    If lineCount > 0 Then ' Create new instance for this batch of lines that is < 20 lines
        Set Instance = Request.Instances.New
        Instance.AddFieldNameValue "StdTextId", TextType & TextID
        Instance.AddFieldNameValue "StartLineNo", startLineNo             ' Starting line of this instance
        Instance.AddFieldNameValue "LineCount", lineCount                 ' Number of lines in this instance
        Instance.AddFieldNameValue "TotalCurrentLines", totalCurrentLines ' Total number of lines in the Text
        Instance.AddFieldNameValue "TotalRetrievedLines", 0               ' Number of Lines already there
        Instance.AddFieldNameValue "TextLine", instanceTextLine           ' Lines of text
        Instance.AddFieldNameValue "HeadingLine", HeadingLine             ' Dummy Heading Line
    End If
    
    If Request.Instances.Count = 0 Then
        MIMS_SetText = True
        Exit Function
    End If
    
    Reply = Block.Send
    
    Set Request = Block.Reply.Requests(2)
    If Request.IsError Then
        GoTo ErrorHandle
    End If
    
    For Each Instance In Request.Instances
        Set Instance = Request.Instances(1)
        If Instance.IsError Then
            GoTo ErrorHandle
        End If
    Next Instance
    
    MIMS_SetText = True

ExitHandle:
    Exit Function
    
ErrorHandle:
    'gstrErrMsg = "Error in MIMS_SetText Request"
    MsgBox Err.Number & " " & Err.Description
    MIMS_SetText = False

End Function

Public Function MIMS_Fetch() As Boolean
On Error GoTo ErrorHandle:
'Stop
    Set TextLines = New Collection

    Dim Block As New MIMSBlock
    Dim Request As MIMSRequest
    Dim Instance As MIMSInstance
    Dim textLine As Variant
    Dim startLineNo As Long
    Dim lineCount As Long
    Dim totalCurrentLines As Long
    Dim lineIDX As Long
    Dim instanceTextLine As String
    Dim i As Integer
    
    Set Block = gobjMIMS.Blocks.New
    Set Request = Block.Requests.New
    Request.AddFieldNameValue MIMSX_FLAG_SERVICE, "STDTEXT.GetText"
    Request.AddFieldNameValue "_ReplyList", "LineCount,StartLineNo,TextLine"
    Request.Instances.New (1)
    Request.Instances(1).AddFieldNameValue "StdTextId", TextType & TextID

    Do While True

        ' Send the Block to MIMS
        On Error Resume Next
        Block.Send
        On Error GoTo 0

        ' Set the Request
        Set Request = Block.Reply.Requests(1)

        ' Process the requests reply
        If Request.IsError Then
            GoTo ErrorHandle
        Else
            For Each Instance In Request.Instances
                If Instance.IsError Then
                    GoTo ErrorHandle
                Else
                    i = 1
                    textLine = Instance.Fields("TextLine")
                    While Len(textLine) > 0
                        TextLines.Add Trim(Mid(textLine, 1, 160))
                        textLine = Mid(textLine, 161, Len(textLine))
                    Wend
                End If
            Next Instance
        End If

        ' Leave loop if no more data to fetch - The reply Request is not a restart when no more data is available
        If Not Request.IsRestart Then
            Exit Do
        End If

        ' prepare to fetch next block of data
        If Request.IsRestart Then
            Request.Fields(MIMSX_FLAG_RESTART) = Request.Fields(MIMSX_FLAG_RESTART)
        Else
            Request.AddFieldNameValue MIMSX_FLAG_RESTART, Request.Fields(MIMSX_FLAG_RESTART)
        End If

    Loop

    MIMS_Fetch = True

ExitHandle:
    Exit Function

ErrorHandle:
    MsgBox Err.Number & " " & Err.Description
    MIMS_Fetch = False

End Function

RE: Using the StdText object

(OP)
Thanks Dallas - that looks promising.  Its even commented!

Steve

RE: Using the StdText object

Steve,

The original version of this is actually mine. Dallas has added the examples and the Purpose.

Since I sent it to Dallas I've found and fixed a bug.

Let me know if you want the fixed version.

Regards,
Mark.

RE: Using the StdText object

Mark,

Congratulations on a pretty nifty piece of code!

Any chance you could post your fixed up version?

RE: Using the StdText object

Mark,

I too am very interested in your corrected code. I am struggling with updating std text at the moment.

Many thanks in advance,
Carly

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close