UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Attaching File As Byte Array, Access 2016    
 
   
aoh
post Feb 21 2018, 03:55 AM
Post#1



Posts: 1,417
Joined: 20-February 04
From: Dublin, Ireland


Hi guys,

I'm sending info to a web service using Soap. An option is to attach a file as a byte array. The code below works but takes 20 minutes for a 1 page PDF and some of my clients need to attach multiple files, so this will take forever. Can anyone see a way of speeding it up?

CODE
        fileNum = FreeFile
        Open rst.Fields("AttachFile") For Binary As fileNum
        ReDim bybytes(LOF(fileNum) - 1)
        Get fileNum, , bybytes
        Close fileNum
  
        strData = strData & "<file>"
        For lngLoop = LBound(bybytes) To UBound(bybytes)
            strData = strData & "<unsignedByte>" & bybytes(lngLoop) & "</unsignedByte>" & vbCrLf
        Next lngLoop
        strData = strData & "</file>" & vbCrLf

--------------------
Anne

Experience is a wonderful thing. It enables you to recognize a mistake when you've just made it again.
Go to the top of the page
 
zaxbat
post Feb 24 2018, 10:11 AM
Post#2



Posts: 1,184
Joined: 26-January 06
From: .....the wiregrass (either you know or you don't)


A couple of things come to mind.....

Evaluating the LBound/Ubound on each loop isn't helping the speed, I think....(though possibly it only evaluates it the first time....I'd take it out anyway).

Concatenating all of this onto a single string has got to be gobbling memory like a black hole eats planets on the larger reports.
To circumvent that I just directly output the data into a txt output file with each iteration of the loop. The vbCRLF is added automatically by the system with this type of output.

Well, I guess that's it. Here are the stats.

Input PDF filesize: 127 pages 1.9MB
Output TXT filesize: 65MB
Total Runtime: 12 seconds (did not time the binary input cause that is super fast anyway)



Here is my code...

Option Compare Database
Dim myarray() As Byte

Private Sub Command0_Click()
Dim myinfile As Long
Dim myoutfile As Long
Dim mystart As Date
Dim myend As Date
Dim arraysize As Long

myinfile = FreeFile
Open "c:\users\... ...\documents\development\demos\testinput.pdf" For Binary Access Read As #myinfile
myarraysize = LOF(myinfile) - 1
ReDim myarray(myarraysize)
Get myinfile, , myarray
Close myinfile

myoutfile = FreeFile
Open "c:\users\... ...\documents\development\demos\outputtest.txt" For Output As #myoutfile

mystart = Time
Print #myoutfile, "<file>"
For counter = 0 To myarraysize
Print #myoutfile, "<unsignedByte>" & myarray(counter) & "</unsignedByte>"
Next counter
Print #myoutfile, "</file>"
Close myoutfile
myend = Time

MsgBox (mystart & myend)


End Sub
This post has been edited by zaxbat: Feb 24 2018, 10:14 AM

--------------------
Kindest regards, and Cheers!
ZAX

A picture is worth a thousand words and a zipped DB is worth a thousand pictures.
Oh, and....please don't disappear into the Twilight Zone.... Holler back with your results!
Go to the top of the page
 
aoh
post Feb 26 2018, 03:53 AM
Post#3



Posts: 1,417
Joined: 20-February 04
From: Dublin, Ireland


Thanks zaxbat, I'll give that a go - but how do I then add the contents of the text file to the XML? Do I just read it back in, line by line?

--------------------
Anne

Experience is a wonderful thing. It enables you to recognize a mistake when you've just made it again.
Go to the top of the page
 
zaxbat
post Feb 26 2018, 12:42 PM
Post#4



Posts: 1,184
Joined: 26-January 06
From: .....the wiregrass (either you know or you don't)


I'm ok with file input/output....but I don't speak HTML
Not sure what to tell you.
I assumed that this was the complete file and that you were sending to a website or browser or something. Give me more info and I'll see if i can help.

--------------------
Kindest regards, and Cheers!
ZAX

A picture is worth a thousand words and a zipped DB is worth a thousand pictures.
Oh, and....please don't disappear into the Twilight Zone.... Holler back with your results!
Go to the top of the page
 
aoh
post Feb 28 2018, 05:13 AM
Post#5



Posts: 1,417
Joined: 20-February 04
From: Dublin, Ireland


Hi zaxbat,

Full code is here. Basically, the users (doctors) are submitting a booking form to a hospital. That part works fine. However, they can also attach documents - sometimes multiple documents - (test results, etc) to the booking form, so they select a file on their PC, and I need to put it into a byte array and send it off. I can write an XML file in seconds, as you said, but if I then try reading it back in, I end up in the same boat.

CODE
Public Function AttachFile(strBookRef As String)
    Dim objXML As Object
    Dim strURL As String
    Dim strURL2 As String
    Dim docDoc As DOMDocument60
    Dim strSQLU As String
    Dim rst As Recordset
    Dim strData As String
    Dim fileNum As Integer
    Dim bybytes() As Byte
    Dim lngLoop As Long
    Dim strSQl As String
    Dim lngStart As Long
    Dim lngEnd As Long
    
    strURL = DLookup("hospitalURL", "tblhospitalUser")
    strURL2 = "http://hospitalTransfer.org/ReceiveSingleFile"
        
    strSQl = "SELECT tblBookhospitalAttach.* FROM tblBookhospitalAttach Where hospitalId = " & Forms!frmBookhospitalAuto.hospitalId
    
    Set rst = CurrentDb.OpenRecordset(strSQl)
    
    Do While Not rst.EOF
        strData = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>" & vbCrLf & _
            "<soap:Envelope xmlns:xsi=" & Chr(34) & "http://www.w3.org/2001/XMLSchema-instance" & Chr(34) & _
            " xmlns:xsd=" & Chr(34) & "http://www.w3.org/2001/XMLSchema" & Chr(34) & _
            " xmlns:soap=" & Chr(34) & "http://schemas.xmlsoap.org/soap/envelope/" & Chr(34) & ">" & vbCrLf & _
            "<soap:Body>" & vbCrLf & _
            "<ReceiveSingleFile  xmlns=" & Chr(34) & "http://hospitalTransfer.org/" & Chr(34) & ">" & vbCrLf
        strData = strData & "<user>" & Forms!frmBookhospitalAuto.user & "</user>" & vbCrLf
        strData = strData & "<password>" & Forms!frmBookhospitalAuto.password & "</password>" & vbCrLf
        strData = strData & "<filename>" & rst.Fields("AttachName") & "</filename>" & vbCrLf
        
        Debug.Print Format(Now(), "HH:nn") & " Start " & rst.Fields("AttachFile")
        
        fileNum = FreeFile
        Open rst.Fields("AttachFile") For Binary As fileNum
        ReDim bybytes(LOF(fileNum) - 1)
        Get fileNum, , bybytes
        Close fileNum
  
        Debug.Print "   Size " & UBound(bybytes)
  
        strData = strData & "<file>"
        lngStart = LBound(bybytes)
        lngEnd = UBound(bybytes)
        For lngLoop = lngStart To lngEnd
            strData = strData & "<unsignedByte>" & bybytes(lngLoop) & "</unsignedByte>" & vbCrLf
        Next lngLoop
        strData = strData & "</file>" & vbCrLf
        strData = strData & "<bookingRef>" & Trim(strBookRef) & "</bookingRef>" & vbCrLf
        strData = strData & "</ReceiveSingleFile>" & vbCrLf
        strData = strData & "</soap:Body>" & vbCrLf
        strData = strData & "</soap:Envelope>" & vbCrLf
        
        Debug.Print Format(Now(), "HH:nn") & " End " & rst.Fields("AttachFile")
        
        Set docDoc = New DOMDocument60
        Set objXML = CreateObject("MSXML2.XMLHTTP")
    
        With objXML
            .Open "POST", strURL, False
            .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .setRequestHeader "SOAPAction", strURL2
            .send strData
            docDoc.loadXML (.responseText)
        End With
        If Left(docDoc.Text, 6) <> "Upload" Then
            MsgBox "The file attachment " & rst.Fields("AttachFile") & " was rejected for the following reason(s):" & vbCrLf & docDoc.Text
            GoTo CloseOff
        Else
            strSQLU = "Update tblBookhospitalAttach Set AttachSuccess = True Where AttachId = " & rst.Fields("AttachId")
            CurrentDb.Execute strSQLU, dbFailOnError
            Forms!frmBookhospitalAuto.sfmBookhospitalAttach.Form.Requery
        End If
        
        rst.MoveNext
    Loop
    
CloseOff:
    
    rst.Close
    Set rst = Nothing
    
    Set objXML = Nothing
    Set docDoc = Nothing
  
End Function

--------------------
Anne

Experience is a wonderful thing. It enables you to recognize a mistake when you've just made it again.
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    25th September 2018 - 04:21 AM