VBA String Manipulation 1

[weightinwildcat]

I am working on VBA code in Access 2010 to get information from a memo field and post it to a cloud based service. I am able to copy information from the memo field into a String variable. Since I am posting to the cloud I am going through the string one character at a time. If a character is a letter or a number, I concatenate that onto another string variable. If the code is a character like #, % or even a blank space I get a URL code and concatenate THAT onto the end of my second string. (This is to avoid problems that the cloud based service may have in processing such characters.)

The problem is that my second variable seems to get truncated when the number of characters is greater than 255. In theory an Access string variable can hold more than 255 characters, and when I get the length of my first string variable this does show there are over 400 characters. however, when I try to do any further manipulation the text gets truncated.

Any thoughts?

 

[1DMF]

As you haven't provided any code it's not possible to comment as to what is causing the problem.

have a read here :

http://www.access-programmers.co.uk/forums/showthread.php?t=154604

You state >> when I try to do any further manipulation the text gets truncated.

What do you call 'manipulation' and is it something that will cause the string to get truncated?

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"
Free Electronic Dance Music

 

[weightinwildcat]

Here is code:

SpeChar(0) = "!"
SpeChar(1) = Chr(34) 'Double Quotation Marks
SpeChar(2) = "#"
SpeChar(3) = "$"
SpeChar(4) = "%"
SpeChar(5) = "&"
SpeChar(6) = Chr(39) 'Single Quotation Mark
SpeChar(7) = "("
SpeChar(8) = ")"
SpeChar(9) = "*"
SpeChar(10) = "+"
SpeChar(11) = ","
SpeChar(12) = "-"
SpeChar(13) = "."
SpeChar(14) = "/"
SpeChar(15) = ":"
SpeChar(16) = ";"
SpeChar(17) = "<"
SpeChar(18) = "="
SpeChar(19) = ">"
SpeChar(20) = "?"
SpeChar(21) = "@"
SpeChar(22) = "["
SpeChar(23) = "\"
SpeChar(24) = "]"
SpeChar(25) = "^"
SpeChar(26) = "_"
SpeChar(27) = "`"
SpeChar(28) = "{"
SpeChar(29) = "|"
SpeChar(30) = "}"
SpeChar(31) = "~"
SpeChar(32) = Chr(13)
SpeChar(33) = Chr(10)
SpeChar(34) = " "

EscChar(0) = "%21" 'Exclamation Point
EscChar(1) = "%22" 'Double Quotation Marks
EscChar(2) = "%23" 'Hash Mark/Number Sign
EscChar(3) = "%24" 'Dollar Sign
EscChar(4) = "%25" 'Percent Sign
EscChar(5) = "%26" 'Ampersand
EscChar(6) = "%27" 'Apostrophe Single Quotation Mark
EscChar(7) = "%28" 'Left Parenthesis
EscChar(8) = "%29" 'Right Parenthesis
EscChar(9) = "%2A" 'Asterisk
EscChar(10) = "%2B" 'Plus Sign
EscChar(11) = "%2C" 'Comma
EscChar(12) = "%2D" 'Dash or Minus Sign
EscChar(13) = "%2E" 'Period
EscChar(14) = "%2F" 'Forward Slash
EscChar(15) = "%3A" 'Colon
EscChar(16) = "%3B" 'Semicolon
EscChar(17) = "%3C" 'Left Arrow
EscChar(18) = "%3D" 'Equal Sign
EscChar(19) = "%3E" 'Right Arrow
EscChar(20) = "%3F" 'Question Mark
EscChar(21) = "%40" 'At Sign
EscChar(22) = "%5B" 'Left Bracket
EscChar(23) = "%5C" 'Backward Slash
EscChar(24) = "%5D" 'Right Bracket
EscChar(25) = "%5E" 'Up Arrow
EscChar(26) = "%5F" 'Underscore
EscChar(27) = "%60" 'Acute, Back quote, grave, grave accent, left quote, open quote, or a push
EscChar(28) = "%7B" 'Left Curly Bracket
EscChar(29) = "%7C" 'Vertical Line
EscChar(30) = "%7D" 'Right Curly Bracket
EscChar(31) = "%7E" 'Tilde
EscChar(32) = "%0A" 'Line Feed
EscChar(33) = "%0D" 'Carriage Return
EscChar(34) = "%20" 'Blank space

Dim db As Database
Dim rs As Recordset
Dim Message As String 'This will hold the Message under the Specific Details label on the ORDERS form.
Dim newMessage As String 'This will hold a processed version of the Message text.
Dim newMessage2 As String
Dim OrderID As Long 'This will hold the order ID, a number distinct from the sales order number.
Dim ProductID As String 'This will hold the product ID.
Dim newTextChar As String
Dim charCount As Long

Set db = CurrentDb()

Set rs = db.OpenRecordset("SELECT ORDERS.OrderNumber, ORDERS.OrderID, ORDERS.Message, " & _
"Trim(ORDERS.ProductID & ' ' & ORDERS.OptionConfig) AS ProductID FROM ORDERS " & _
"INNER JOIN Proofs ON ORDERS.OrderID = Proofs.OrderID " & _
"WHERE Proofs.proofReq = True AND ORDERS.OrderDate>=#1/1/2013# " & _
"AND ORDERS.OrderNumber = " & SONumber, dbReadOnly)

Message = ""
newMessage = ""

If rs.RecordCount > 0 Then
rs.MoveFirst

Do While Not rs.EOF
If Len(rs!Message) > 0 Then
Message = rs!Message 'Gets the Message.

charCount = Len(rs!Message)

For i = 1 To charCount
newTextChar = Mid(rs!Message, i, 1)

If (Asc(Mid(rs!Message, i, 1)) > 57 And Asc(Mid(rs!Message, i, 1))) < 65 _
Or (Asc(Mid(rs!Message, i, 1)) > 90 And Asc(Mid(rs!Message, i, 1))) < 97 _
Or Asc(Mid(rs!Message, i, 1)) < 32 _
Or Asc(Mid(rs!Message, i, 1)) > 122 Then
For j = 0 To 34
If SpeChar(j) = newTextChar Then
charFound = True
newMessage = newMessage & EscChar(j)
Exit For
Else
charFound = False
End If
Next
End If

If charFound = False Then
newMessage = newMessage & newTextChar
End If

newTextChar = ""
Next

OrderID = rs!OrderID
ProductID = rs!ProductID
Call UpdateActivity(SONumber, OrderID, ProductID, newMessage) 'Shows the message as a comment under Activity.
End If

rs.MoveNext
Loop
End If



Public Function UpdateActivity(SONumber, OrderID, ProductID As String, Message As String)
Dim db As Database
Dim rs As Recordset
Dim cardID As String


Call SetGlobalValues

Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT cardID FROM TR_CARDS WHERE OrderNumber = " & _
SONumber, dbReadOnly)

If rs.RecordCount = 1 Then
cardID = rs!cardID

Call AddTrelloActivity(cardID, "The details for the " & ProductID & " on order %23" & _
SONumber & " now read: " & Message & ". " & _
"The order ID code for this line item is " & OrderID & ".")
End If

rs.Close
Set rs = Nothing

db.Close
Set db = Nothing
End Function



Public Function AddActivity(cardID, textVal)

Dim objSvrHTTP As MSXML2.ServerXMLHTTP60 'Declares an variable for use in establishing HTTP connections.
Set objSvrHTTP = New MSXML2.ServerXMLHTTP60 'Creates an instance of an object for establishing HTTP connections.
Dim trURL As String 'This will hold a URL with information needed to perform a task on Trello.

'This initializes trURL with information needed to add comments to a Trello card.
trURL = "

https://api.service.com/1/"

& _
"cards/" & cardID & "/actions/comments/?text=" & textVal & _
"&key=" & keyVal & "&token=" & tokenVal

objSvrHTTP.Open "POST", trURL 'Initializes a request and specifies the method, URL, and needed authentication information, if any.
objSvrHTTP.SetRequestHeader "Content-Type", "application/json" 'Specifies the name of an HTTP header.
objSvrHTTP.Send ("") 'Sends an HTTP request to the server and receives a response.

Set objSvrHTTP = Nothing

End Function

 

[1DMF]

Where is the string 400 char as you state and where do you believe it is being truncated?

You've not used code tags or formatting and reading that isn't easy.

also are you trying to URL encode a string?

You should outsource that to a function, pass it the raw string and get back the encoded string.

Have a look here :

http://www.freevbcode.com/ShowCode.asp?ID=5137

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"
Free Electronic Dance Music

 

[strongm]

>the cloud based service may have in processing such characters

Are you sure you need to encode ALL those characters. There's a pretty well-defined set of characters that a URL to cloud-based services should handle perfectly OK.

In which case you might find the following function useful:

[blue]Private Declare Sub UrlEscapeA Lib "shlwapi.dll" (ByVal pszUrl As String, ByVal pszEscaped As String, ByRef pcchEscaped As Long, ByVal dwFlags As Long)

Public Function EscapeURLText(strURLText As String) As String
    Dim sz As Long
    Dim strResult As String
    Dim result As Long
    sz = Len(strURLText) * 3
    strResult = Space(sz)
    UrlEscapeA strURLText, strResult, sz, &H2000
    EscapeURL = Left(strResult, sz)
End Function[/blue]

 

[1DMF]

Nice one Mike, didn't realise there was a library you could import to URL encode.

OP ^ What strongm Say's!

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"
Free Electronic Dance Music

 

[weightinwildcat]

We solved our problem when we went from this

objSvrHTTP.Open "POST", trURL 'Initializes a request and specifies the method, URL, and needed authentication information, if any.
objSvrHTTP.SetRequestHeader "Content-Type", "application/json" 'Specifies the name of an HTTP header.
objSvrHTTP.Send ("") 'Sends an HTTP request to the server and receives a response.

to this

'Initializes a request and specifies the method, URL, and needed authentication information, if any.
objSvrHTTP.Open "POST", "

https://api.service.com/1/cards/"

& cardID & "/actions/comments/?text"
objSvrHTTP.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary 'Specifies the name of an HTTP header.
objSvrHTTP.SetRequestHeader "Accept", "*/*" 'Specifies the name of an HTTP header.
objSvrHTTP.SetRequestHeader "Accept-Encoding", "gzip , deflate" 'Specifies the name of an HTTP header.
objSvrHTTP.SetRequestHeader "Accept-Language", "en-US,en;q=0.8" 'Specifies the name of an HTTP header.
objSvrHTTP.SetRequestHeader "Connection", "keep-alive" 'Specifies the name of an HTTP header.
'objSvrHTTP.SetRequestHeader "Content-Length", UBound(FileContents) + 1 'Specifies the name of an HTTP header.
objSvrHTTP.Send pvToByteArray(PostMsg) 'Sends an HTTP request to the server and receives a response.
'objSvrHTTP.WaitForResponse

Not sure why this works with the longer strings.

 

[1DMF]

>> objSvrHTTP.Send pvToByteArray(PostMsg) 'Sends an HTTP request to the server and receives a response.

Am I to assume PostMsg is the long string and you are now sending it as a ByteArray?


"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"
Free Electronic Dance Music