kfschaefer
Registered User.
- Local time
- Today, 05:22
- Joined
- Oct 10, 2008
- Messages
- 58
I want to delete/Replace only a portion of the text with the Memo field. ie. the auto update of the Memo field enters data from various fields on the form without affecting the original users comments with in the memo field.
Here is my current code that updates my memo field- however when it gets to the Req EMo fields data It wants to duplicate the entry instead of replace See '>>>>>>> portion of the code
I am using the Replace function, however, portion of the before text is still being set in the comments after the Replace function is run.
If I update run the initial update of the comments, then make a change to the REQ_EMO fields, rerun the code and it will update the change data, but also include portion of the unchanged data to create duplicate data, see the attached image.
Here is my latest code I narrowed down the problem area see '>>>>>>>>>>>>>>>> portion of the code - especially the setting of the gvalue. It is here it seems to want to hold onto portion of the searchfor data.
any suggestions,
K
Here is my current code that updates my memo field- however when it gets to the Req EMo fields data It wants to duplicate the entry instead of replace See '>>>>>>> portion of the code
I am using the Replace function, however, portion of the before text is still being set in the comments after the Replace function is run.
If I update run the initial update of the comments, then make a change to the REQ_EMO fields, rerun the code and it will update the change data, but also include portion of the unchanged data to create duplicate data, see the attached image.
Here is my latest code I narrowed down the problem area see '>>>>>>>>>>>>>>>> portion of the code - especially the setting of the gvalue. It is here it seems to want to hold onto portion of the searchfor data.
any suggestions,
K
Code:
Private Sub cmdCopyWSNo_Click()
Dim MaxWidth(1 To 3) As Long
Dim iEMO(4) As Long
Dim i As Integer
MaxWidth(1) = 15
MaxWidth(2) = 10
MaxWidth(3) = 0
Set curDB = Application.CurrentDb
sFieldName = vbNullString
recValue = vbNullString
strSQL = vbNullString
Select Case Me.Work_Code
Case 1, 3
gWC = Me.Work_Code.Column(1)
End Select
gJG = Me.Job_Group
gLab = Me.Cmis_Lab
strSQL = "SELECT *" & _
" FROM tblEquipListingPerJobGroup" & _
" WHERE (Job_Group=" & Chr(39) & gJG & Chr(39) & ")"
Set rs = curDB.OpenRecordset(strSQL)
sFieldName = UCase(SPad(rs.Fields("Equipment_ID").Name, MaxWidth(1)))
sFieldName = UCase(sFieldName & SPad(rs.Fields("MeasNo").Name, MaxWidth(2)))
sFieldName = UCase(sFieldName & SPad(rs.Fields("WSNo").Name, MaxWidth(3)))
If Nz(Me.RequestorComments) = "" Then
If gLab = "F100" Then
recValue = "WORK CODE: " & gWC
GoSub MyUpdate
Else
'Data from tblEquipListingPerJobGroup
With rs
If Not (.BOF And .EOF) Then
.MoveFirst
Do Until .EOF
If recValue <> "" Then recValue = recValue & RSLF
recValue = recValue & SPad(.Fields("Equipment_ID"), MaxWidth(1))
recValue = recValue & SPad(.Fields("MeasNo"), MaxWidth(2))
recValue = recValue & SPad(.Fields("WSNo"), MaxWidth(3))
.MoveNext
Loop
End If
End With
recValue = sFieldName & RSLF & recValue & RSLF & "WORK CODE: " & gWC
Me.RequestorComments = recValue & gOrigComment
GoTo ResumeNext:
End If
ElseIf Nz(Me.RequestorComments) <> "" Then
If gLab = "F100" Then
recValue = "WORK CODE: " & gWC
GoSub MyUpdate
'Data from tblEquipListTemp
Else
With rs
If Not (.BOF And .EOF) Then
.MoveFirst
Do Until rs.EOF
If recValue <> "" Then recValue = recValue & RSLF
recValue = recValue & SPad(.Fields("Equipment_ID"), MaxWidth(1))
recValue = recValue & SPad(.Fields("MeasNo"), MaxWidth(2))
recValue = recValue & SPad(.Fields("WSNo"), MaxWidth(3))
.MoveNext
Loop
End If
End With
recValue = sFieldName & RSLF & recValue & RSLF & "WORK CODE: " & gWC
End If
End If
'---------------------------------------------------------------------------------------
'>>>>>>>>>>> 'copy Req EMO data into Comments field.
'---------------------------------------------------------------------------------------
If Not IsNull(Me.RequestorComments) = True Then
If InStr(Me.RequestorComments, "Req Emo") = 0 Then
gEMO1 = Me.REQ_EMO1
gEMO2 = Me.REQ_EMO2
gEMO3 = Me.REQ_EMO3
gEMO4 = Me.REQ_EMO4
If Not IsNull(gEMO1) Or Not IsNull(gEMO2) Or Not IsNull(gEMO3) Or Not IsNull(gEMO4) Then
iEMO(1) = gEMO1
iEMO(2) = gEMO2
iEMO(3) = gEMO3
iEMO(4) = gEMO4
For i = 1 To 4
If iEMO(i) > 0 Then
recValue = recValue & RSLF & "Req Emo" & i & ": " & iEMO(i)
End If
Next
End If
' Debug.Print recValue
ElseIf InStr(Me.RequestorComments, "Req EMO") > 0 Then
Select Case _
MsgBox("The Comments of this Service Request Record, currently contains REQ EMO data, Do you wish to replace Req EMO Data?", _
vbYesNo Or vbExclamation Or vbDefaultButton1, "Req EMO Data")
Case vbYes
gEMO1 = Me.REQ_EMO1
gEMO2 = Me.REQ_EMO2
gEMO3 = Me.REQ_EMO3
gEMO4 = Me.REQ_EMO4
If Not IsNull(gEMO1) Or Not IsNull(gEMO2) Or Not IsNull(gEMO3) Or Not IsNull(gEMO4) Then
iEMO(1) = gEMO1
iEMO(2) = gEMO2
iEMO(3) = gEMO3
iEMO(4) = gEMO4
For i = 1 To 4
If iEMO(i) > 0 Then
recValue = recValue & RSLF & "Req Emo" & i & ": " & iEMO(i)
End If
Next
End If
GoSub MyUpdate:
GoTo ResumeNext:
Case vbNo
GoTo ResumeNext:
End Select
End If
'GoSub MyUpdate:
End If
'Modify Comments on the SR Main form
MyUpdate:
Set gcomments = Me.Controls("RequestorComments")
strSearchFor = GetCommentData.TestEquipmentDetails
Set gcomments = Nothing
strReplaceWith = recValue
strSearch = Nz(Me.RequestorComments)
If strSearchFor = "" Then
gValue = strReplaceWith & RSLF & strSearch
Else
gValue = Replace(strSearch, strSearchFor, strReplaceWith)
End If
Me.RequestorComments = gValue
GoTo ResumeNext:
Return
ResumeNext:
rs.Close
Set rs = Nothing
Me.RequestorComments.Requery
Me.Repaint
End Sub
Function SPad(ByVal InString As Variant, Optional ByVal PadToWidth As Long = 0, _
Optional ByVal PadChar As String = " ") As String
'returns string InString padded with character PadChar to a total width of PadToWidth characters
'PadToWidth positive values: padding added to end (right) of string InString
'PadToWidth negative values: padding added to beginning (left) of string InString
Dim n As Long
If Len(Nz(InString)) < PadToWidth Then
For n = 1 To Abs(PadToWidth) - Len(Nz(InString))
SPad = SPad & PadChar
Next n
End If
Select Case PadToWidth
Case Is > 0
SPad = Nz(InString) & SPad
Case Is < 0
SPad = SPad & Nz(InString)
Case Else
SPad = Nz(InString)
End Select
End Function