MS Access VBA Text String Missing From The End Of A String After Stream

I am building a string and at the very bottom of the string is a file being streamed into the text. But the is supposed to be a small section of string after the stream. It is missing!

xmlFile = "<?xml version=""1.0"" encoding=""UTF-8""?><uploadFileRequest xmlns=""http://www.ebay.com/marketplace/services""><taskReferenceId>" & TaskRefId & "</taskReferenceId><fileReferenceId>" & FileRefId & "</fileReferenceId><fileFormat>gzip</fileFormat><fileAttachment><Data><xop:Include href=""cid:urn:uuid:" & FileAttachmentUUID & """  xmlns:xop=""http://www.w3.org/2004/08/xop/include""/></Data><Size>15</Size></fileAttachment></uploadFileRequest>"
    strFile = GetFile(strFileName) 'Calls GetFile and loads the (Gzip Format) File as a binary attachment.

'***********************************************************************************************************
'Build The body
'***********************************************************************************************************
strBody = vbNewLine & vbNewLine & "--MIMEBoundaryurn_uuid_" & RequestUUID & vbNewLine 'Unsure of line spacing between header and Body 1,2,or 3?????
'strBody = strBody & "Content-Disposition: form-data; name="fieldNameHere"; filename="uploadFileNEWGOOD.xml" & vbNewLine
strBody = strBody & "Content-Type: text/xml" & vbNewLine
strBody = strBody & "Content-Transfer-Encoding: binary" & vbNewLine
strBody = strBody & "Content-ID: <0.urn:uuid:" & XMLUUID & ">" & vbNewLine
strBody = strBody & vbNewLine  'Space between XML File Header and XML File Body!

strBody = strBody & xmlFile & vbNewLine 'XML uploadFile File Body!
strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & vbNewLine
'strBody = strBody & "Content-Disposition: form-data; name="fieldNameHere"; filename="AFPIBulkTest1.gz" & vbNewLine
strBody = strBody & "Content-Type: application/x-gzip" & vbNewLine
strBody = strBody & "Content-Transfer-Encoding: binary" & vbNewLine
strBody = strBody & "Content-ID: <0.urn:uuid:" & FileAttachmentUUID & ">" & vbNewLine
strBody = strBody & vbNewLine  'Space between File Attachment Header and File Attachment Body!

        

strBody = strBody & strFile
strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & "--"

'*********************************************
'Returns file contents As a binary data
'*********************************************
Function GetFile(Filename)
  Dim Stream: Set Stream = CreateObject("ADODB.Stream")
  Stream.Type = 1 'Binary is value 1.
  Stream.Open
  Stream.LoadFromFile Filename
  GetFile = Stream.Read
  Stream.Close
End Function

Open in new window



strBody = strBody & strFile This is the stream
strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & "--" This part is missing!

Thanks.
LVL 1
Dustin StanleyEntrepreneurAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

als315Commented:
Can you show full code?
May be you have anywhere on error goto ...
What you see in debugger?
0
Gustav BrockCIOCommented:
Check the last byte(s) of strFile:

    Debug.Print Asc(Right(strFile, 1))
    Debug.Print Asc(Right(strFile, 2))

that these are not 0 (null) or 26 (EOF) or other non-printable bytes.

/gustav
0
Dustin StanleyEntrepreneurAuthor Commented:
Gustav
Debug.Print Asc(Right(strFile, 1))
    Debug.Print Asc(Right(strFile, 2))

I got

Debug.Print Asc(Right(strFile, 1)) = 0
    Debug.Print Asc(Right(strFile, 2)) = 63

What exact parts does this check?
Where is the middle or what differs left from right? Thanks

Whole Code:
Option Compare Database
Option Explicit

Public Function uploadFile()
    Dim reader As New MSXML2.XMLHTTP40
    Dim Doc As New MSXML2.DOMDocument
    Dim lngLength As Long
    Dim TokenValue As String
    Dim APICALL As String
    Dim DevName As String
    Dim AppName As String
    Dim CertName As String
    Dim FP1 As String
    Dim Service As String
    Dim xmlFile As String
    Dim XMLUUID As String
    Dim RequestUUID As String
    Dim FileAttachmentUUID As String
    Dim ContentType As String
    Dim strBody As String
    Dim TaskRefId As String
    Dim FileRefId As String
    Dim strFileName As String
    Dim strFile As String
    
     ' On Error GoTo Proc_Err
    

    TokenValue = Forms!frmEbayAuthentication!txtTokenCode ' This is used for the Token Code insert manually on the Form Ebay Add Fixed Price Item.
    DevName = Forms!frmEbayAuthentication!txtDevName 'Supplied by ebay.
    AppName = Forms!frmEbayAuthentication!txtAppName 'Supplied by ebay.
    CertName = Forms!frmEbayAuthentication!txtCertName 'Supplied by ebay.
    APICALL = "uploadFile" ' MORE INFO HERE: https://developer.ebay.com/DevZone/file-transfer/CallRef/uploadFile.html
    FP1 = "C:\Users\Station\Documents\Access XML Save Files\New Testing\"
    strFileName = FP1 & "AFPIBulkTest1.gz"
    lngLength = Len(strBody) ' the length of the HTTP request
    Service = "FileTransferService"
    RequestUUID = Forms!frmuploadFile!txtRequestUUID
    XMLUUID = Forms!frmuploadFile!txtXMLUUID
    FileAttachmentUUID = Forms!frmuploadFile!txtFileAttachmentUUID
    ContentType = "multipart/related; boundary=MIMEBoundaryurn_uuid_" & RequestUUID & ";type=""application/xop+xml"";start=" & """" & "<0.urn:uuid:" & XMLUUID & ">"";start-info=""text/xml"""
    TaskRefId = DLookup("jobId", "createUploadJobResponse") 'NOT THE BEST SOLUTION BUT WORKS
    FileRefId = DLookup("fileReferenceId", "createUploadJobResponse") 'NOT THE BEST SOLUTION BUT WORKS
    'uploadFile XML File
    xmlFile = "<?xml version=""1.0"" encoding=""UTF-8""?><uploadFileRequest xmlns=""http://www.ebay.com/marketplace/services""><taskReferenceId>" & TaskRefId & "</taskReferenceId><fileReferenceId>" & FileRefId & "</fileReferenceId><fileFormat>gzip</fileFormat><fileAttachment><Data><xop:Include href=""cid:urn:uuid:" & FileAttachmentUUID & """  xmlns:xop=""http://www.w3.org/2004/08/xop/include""/></Data><Size>15</Size></fileAttachment></uploadFileRequest>"
    strFile = GetFile(strFileName) 'Calls GetFile and loads the (Gzip Format) File as a binary attachment.


'***********************************************************************************************************
'Build The body
'***********************************************************************************************************
strBody = vbNewLine & vbNewLine & "--MIMEBoundaryurn_uuid_" & RequestUUID & vbNewLine 'Unsure of line spacing between header and Body 1,2,or 3?????
'strBody = strBody & "Content-Disposition: form-data; name="fieldNameHere"; filename="uploadFileNEWGOOD.xml" & vbNewLine
strBody = strBody & "Content-Type: text/xml" & vbNewLine
strBody = strBody & "Content-Transfer-Encoding: binary" & vbNewLine
strBody = strBody & "Content-ID: <0.urn:uuid:" & XMLUUID & ">" & vbNewLine
strBody = strBody & vbNewLine  'Space between XML File Header and XML File Body!

strBody = strBody & xmlFile & vbNewLine 'XML uploadFile File Body!
strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & vbNewLine
'strBody = strBody & "Content-Disposition: form-data; name="fieldNameHere"; filename="AFPIBulkTest1.gz" & vbNewLine
strBody = strBody & "Content-Type: application/x-gzip" & vbNewLine
strBody = strBody & "Content-Transfer-Encoding: binary" & vbNewLine
strBody = strBody & "Content-ID: <0.urn:uuid:" & FileAttachmentUUID & ">" & vbNewLine
strBody = strBody & vbNewLine  'Space between File Attachment Header and File Attachment Body!

        

strBody = strBody & strFile
strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & "--"

Debug.Print Asc(Right(strFile, 1))
    Debug.Print Asc(Right(strFile, 2))

'***********************************************************************************************************
'The Call
'***********************************************************************************************************
    
    
    Doc.Load FP1 & APICALL & ".xml" 'Document Location of the XML File With Items Being Added

    
    reader.Open "POST", "https://storage.sandbox.ebay.com/FileTransferService", False 'CHANGE FOR PRODUCTION!
    reader.setRequestHeader "Content-type", ContentType
    reader.setRequestHeader "X-EBAY-SOA-SERVICE-NAME", Service
    reader.setRequestHeader "X-EBAY-SOA-OPERATION-NAME", APICALL
    reader.setRequestHeader "X-EBAY-SOA-SECURITY-TOKEN", TokenValue
    reader.setRequestHeader "X-EBAY-SOA-REQUEST-DATA-FORMAT", "XML"
    reader.setRequestHeader "X-EBAY-SOA-RESPONSE-DATA-FORMAT", "XML"
    reader.setRequestHeader "Content-Length", lngLength ' the length of the HTTP request
    
    MsgBox xmlFile, , "uploadFile XML"
    MsgBox strBody, , "String Body"
    Call SaveStringAsTextFile(FP1 & "strBody.txt", strBody) 'Save strBody to file to examine.

    reader.send strBody 'This sends the XML document from above.
    
Do Until reader.ReadyState = 4
        DoEvents
    Loop
    
    MsgBox (reader.responseText), , "Response" 'Success or Failure
    
    If reader.Status = 200 Then
        Set Doc = reader.responseXML
        Doc.Save FP1 & APICALL & "_ReturnFile.xml" 'This is the return response from ebay after the document is sent and they process it.
        
        Application.ImportXML FP1 & APICALL & "_ReturnFile.xml", acAppendData
        
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description & " in " & _
   VBE.ActiveCodePane.CodeModule, vbOKOnly, "Error"
    End If
    Set reader = Nothing
    
  

Exit Function ' sub
  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   UploadFileRequest"
End Function

'*********************************************
'Returns file contents As a binary data
'*********************************************
Function GetFile(Filename)
  Dim Stream: Set Stream = CreateObject("ADODB.Stream")
  Stream.Type = 1 'Binary is value 1.
  Stream.Open
  Stream.LoadFromFile Filename
  GetFile = Stream.Read
  Stream.Close
End Function

Public Sub SaveStringAsTextFile(psPathFile As String, psFileContents)
'160730 strive4peace
   Dim iFile As Integer
   
   iFile = FreeFile
   Open psPathFile For Output As iFile
   Print #iFile, psFileContents
   Close iFile

End Sub

Open in new window

0
Acronis True Image 2019 just released!

Create a reliable backup. Make sure you always have dependable copies of your data so you can restore your entire system or individual files.

Gustav BrockCIOCommented:
The ascii 0 is the string terminating character. In VBA it should not appear within a string.

So try using:

    strBody = strBody & Left(strFile, Len(strFile) - 1)
    strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & "--"

or:

    strBody = strBody & Replace(strFile, Chr(0), "")
    strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & "--"

or:

    strBody = strBody & Split(strFile, Chr(0))(0)
    strBody = strBody & "--MIMEBoundaryurn_uuid_" & RequestUUID & "--"

/gustav
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Dustin StanleyEntrepreneurAuthor Commented:
Thank you Gustav. It seems to work. But what is the difference between the 3 codes you gave me. They all seem to produce the same thing. Maybe I over looked. Thanks
0
Gustav BrockCIOCommented:
It's a matter of taste which method to choose.

/gustav
0
Dustin StanleyEntrepreneurAuthor Commented:
Thanks Gustav. My taste is working taste. That's it! Thanks.
0
Gustav BrockCIOCommented:
You are welcome!

/gustav
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.