J
Jack
I am having difficulties with my code and need the best way to proceed. I am
extracting data from web form that needs to be placed in its own field
(table). Everything works perfect except where there is memo box. I believe
it has something to do with the chr(13). Could you please take a look at code
and tell me how to 1) remove all double chr(13). I have tried using replace
without success.
Thank you,
Jack
Do Until rstExchange.EOF ' Begin loop.
' Extract the details from the Web Form email
search_source = ExtractDetail(rstExchange!body, "search_source: ")
client_first_name = ExtractDetail(rstExchange!body, "client_first_name:
")
client_last_name = ExtractDetail(rstExchange!body, "client_last_name: ")
client_address1 = ExtractDetail(rstExchange!body, "client_address1: ")
client_address2 = ExtractDetail(rstExchange!body, "client_address2: ")
client_city = ExtractDetail(rstExchange!body, "client_city: ")
client_state = ExtractDetail(rstExchange!body, "client_state: ")
client_zip = ExtractDetail(rstExchange!body, "client_zip: ")
client_email = ExtractDetail(rstExchange!body, "client_email: ")
home_phone = ExtractDetail(rstExchange!body, "home_phone: ")
incident_detail = ExtractDetail(rstExchange!body, "comments:")
****---> I tried this 'If Len(comments) > 0 And InStr(incident_detail,
Chr(13)) Then
'comments = Replace(Replace(comments, Chr(13) & Chr(13), " "), " ", " ")
If Len(client_email) > 0 And InStr(client_email, "@") Then
postIt = vbYes
If postIt = vbYes Then
On Error Resume Next
rstUsers.AddNew ' Create new record.
rstUsers("search_source") = search_source
rstUsers("client_first_name") = client_first_name
rstUsers("client_last_name") = client_last_name
rstUsers("client_address1") = client_address1
rstUsers("client_address2") = client_address2
rstUsers("client_city") = client_city
rstUsers("client_state") = client_state
rstUsers("client_zip") = client_zip
rstUsers("client_email") = client_email
rstUsers("home_phone") = home_phone
rstUsers("comments") = comments
rstUsers.Update ' Save changes.
On Error GoTo errCmdUserDetails
Else
If postIt = vbCancel Then
GoTo exitCmdUserDetails
End If
End If
End If
rstExchange.MoveNext ' Locate next record.
Loop ' End of loop.
exitCmdUserDetails:
rstExchange.Close ' Close table.
rstUsers.Close
Set dbs = Nothing
Exit Sub
errCmdUserDetails:
Error Err.Description
GoTo exitCmdUserDetails
End Sub
Public Function ExtractDetail(textLine As Variant, FormItemReq As String) As
Variant
' extracting the
' detail for a given form field as the text information
' between the required form item and the next carriage return
Dim StartLine As Variant, EndLine As Variant, ExtractText As Variant
StartLine = InStr(textLine, FormItemReq)
If StartLine > 0 Then
StartLine = StartLine + Len(FormItemReq)
EndLine = InStr(StartLine, textLine, Chr(13))
ExtractText = Mid(textLine, StartLine, EndLine - StartLine)
End If
****----> I tried this here too:
If ExtractText = Chr(13) Then ExtractText = Replace(Replace(ExtractText,
Chr(13) & Chr(13), " "), " ", " ")
****----> This cleaned up extra spaces:
ExtractDetail = Trim(ExtractText)
End Function
extracting data from web form that needs to be placed in its own field
(table). Everything works perfect except where there is memo box. I believe
it has something to do with the chr(13). Could you please take a look at code
and tell me how to 1) remove all double chr(13). I have tried using replace
without success.
Thank you,
Jack
Do Until rstExchange.EOF ' Begin loop.
' Extract the details from the Web Form email
search_source = ExtractDetail(rstExchange!body, "search_source: ")
client_first_name = ExtractDetail(rstExchange!body, "client_first_name:
")
client_last_name = ExtractDetail(rstExchange!body, "client_last_name: ")
client_address1 = ExtractDetail(rstExchange!body, "client_address1: ")
client_address2 = ExtractDetail(rstExchange!body, "client_address2: ")
client_city = ExtractDetail(rstExchange!body, "client_city: ")
client_state = ExtractDetail(rstExchange!body, "client_state: ")
client_zip = ExtractDetail(rstExchange!body, "client_zip: ")
client_email = ExtractDetail(rstExchange!body, "client_email: ")
home_phone = ExtractDetail(rstExchange!body, "home_phone: ")
incident_detail = ExtractDetail(rstExchange!body, "comments:")
****---> I tried this 'If Len(comments) > 0 And InStr(incident_detail,
Chr(13)) Then
'comments = Replace(Replace(comments, Chr(13) & Chr(13), " "), " ", " ")
If Len(client_email) > 0 And InStr(client_email, "@") Then
postIt = vbYes
If postIt = vbYes Then
On Error Resume Next
rstUsers.AddNew ' Create new record.
rstUsers("search_source") = search_source
rstUsers("client_first_name") = client_first_name
rstUsers("client_last_name") = client_last_name
rstUsers("client_address1") = client_address1
rstUsers("client_address2") = client_address2
rstUsers("client_city") = client_city
rstUsers("client_state") = client_state
rstUsers("client_zip") = client_zip
rstUsers("client_email") = client_email
rstUsers("home_phone") = home_phone
rstUsers("comments") = comments
rstUsers.Update ' Save changes.
On Error GoTo errCmdUserDetails
Else
If postIt = vbCancel Then
GoTo exitCmdUserDetails
End If
End If
End If
rstExchange.MoveNext ' Locate next record.
Loop ' End of loop.
exitCmdUserDetails:
rstExchange.Close ' Close table.
rstUsers.Close
Set dbs = Nothing
Exit Sub
errCmdUserDetails:
Error Err.Description
GoTo exitCmdUserDetails
End Sub
Public Function ExtractDetail(textLine As Variant, FormItemReq As String) As
Variant
' extracting the
' detail for a given form field as the text information
' between the required form item and the next carriage return
Dim StartLine As Variant, EndLine As Variant, ExtractText As Variant
StartLine = InStr(textLine, FormItemReq)
If StartLine > 0 Then
StartLine = StartLine + Len(FormItemReq)
EndLine = InStr(StartLine, textLine, Chr(13))
ExtractText = Mid(textLine, StartLine, EndLine - StartLine)
End If
****----> I tried this here too:
If ExtractText = Chr(13) Then ExtractText = Replace(Replace(ExtractText,
Chr(13) & Chr(13), " "), " ", " ")
****----> This cleaned up extra spaces:
ExtractDetail = Trim(ExtractText)
End Function