Avatar of Dustin Stanley
Dustin Stanley
 asked on

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.
Microsoft AccessVBA

Avatar of undefined
Last Comment
Gustav Brock

8/22/2022 - Mon
als315

Can you show full code?
May be you have anywhere on error goto ...
What you see in debugger?
Gustav Brock

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
Dustin Stanley

ASKER
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

Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
ASKER CERTIFIED SOLUTION
Gustav Brock

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Dustin Stanley

ASKER
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
Gustav Brock

It's a matter of taste which method to choose.

/gustav
Dustin Stanley

ASKER
Thanks Gustav. My taste is working taste. That's it! Thanks.
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Gustav Brock

You are welcome!

/gustav