I try to load chunks of a (really) large file in VBA:
Set dataStream = CreateObject("ADODB.Stream")
dataStream.Type = adTypeBinary
dataStream.Open
dataStream.LoadFromFile localDirectory & "\" & objFile.Name
byteBuffer = dataStream.Read(bufferSize)
If I understand correctly, the only amount of memory needed at a given time is bufferSize. Still, Access crashes at the LoadFromFile statement.
Is there a more robust way to read chunks from large files in VBA than ADODB.Stream?
I already tried How to Transfer Large File from MS Word Add-In (VBA) to Web Server? (but that has problems with large files, too. Get fails unpredictably with Error 63).
Ok, here's how I solved it
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(localDirectory)
Set sourceFile = objFSO.OpenTextFile(localDirectory & "\" & objFile.Name)
strChunk = sourceFile.Read(bufferSize)
and then convert the string to a byte array:
Function StringToByteArray(str As String) As Byte()
Dim i As Long
Dim b() As Byte
ReDim b(Len(str) - 1) As Byte
For i = 1 To Len(str)
b(i - 1) = Asc(Mid(str, i, 1))
Next i
StringToByteArray = b
End Function
The usual StrConv method does not work correctly! Therefore the method.
Command dataStream.LoadFromFile tries to load the entire file into RAM. You can check it yourself through the Task Manager.
Simple methods give more opportunities, so I suggest it be simpler. Below is the code that I applied to a 50GB file – and my computer didn't experience any problems, except that processing such a file will take a lot of time. But nothing freezes, and the process can be controlled as you like.
Dim fname As String
Dim fNo As Integer
Const bufferSize = 1024
Dim nextBytes(bufferSize) As Byte
Dim offset As Variant
fname = "C:\Path\BinaryFile.vdi"
fNo = FreeFile()
Open fname For Binary Access Read As #fNo
offset = 1
Do
Get #fNo, offset, nextBytes
offset = offset + bufferSize
' Do Something
If EOF(fNo) Then Exit Do
Loop
Close #fNo
Related
So I have a large vba string I am trying to write as binary to a file. I have a function which does so beautifully. I have a string which is very long, about 80k lets say. This string reads in from a file correctly, passes through functions correctly, prints to screen correctly. But no matter what I do, in any way shape or form can i get more than 39k into the file. I have split the string into smaller bits figuring this is a VBA limitation. Then passing it to my fuction 42 characters at a time. Seek(LOF) +1 put is what im doing after open bin but... It doesn't seem to matter how I call it. Binary, ASCI, writing it all at once. I only get the last 39k. Here is the function im using to write to file. This is a memory limitation not a grammar error as far as I can tell and probably has little to do with the form of my code as much as some thing I seem not to get.
sub IBorrowedThis(hex_val as string)
dim output() as string
dim handle as long
output = Split(hex_val, "|")
handle = FreeFile
open "fp" for binary as #handle
For i = LBound(output) to Unbound(output)
seek #handle,LOF(handle) + 1
put #handle, , cbyte("&H" & output(i))
next i
close #handle
end sub
So I have tested this all in pieces and everything works. appending to the end included. just not for large files.
Another more simple way to write a binary string to a file:
SUB WriteBinaryStringToFile (hex_val AS STRING)
DIM handle AS LONG
handle = FREEFILE
OPEN "binary2.tst" FOR BINARY AS #handle
SEEK #handle, LOF(handle) + 1
PUT #handle, , hex_val
CLOSE #handle
END SUB
Simple method to write binary string to file:
SUB WriteBinaryStringToFile (hex_val AS STRING)
DIM c AS STRING * 1
DIM I AS LONG
DIM handle AS LONG
handle = FREEFILE
OPEN "fp" FOR BINARY AS #handle
FOR I = 1 TO LEN(hex_val)
c = MID$(hex_val, I, 1)
SEEK #handle, LOF(handle) + 1
PUT #handle, , c
NEXT I
CLOSE #handle
END SUB
I have an MS SQL Database from a customer with an Access Application.
This application stores files within this MS SQL database.
I tried to just get the bytes from the database and just save them to the disk.
With some of the files this works and with some it does not.
(images don't work, zips work, wordfiles are to open but word has to recover them)
I found out that Access saves the files within an OLE Object.
So i need to get out the Original Files from the OLE Object!
It seems that this is quite difficult.
I tried to find a .NET library which can seperate the files from the OLE Object.. found nothing...
Now i am trying to get the files out with Access...
It seems that i neet a getChunk Function to do that...
Found this page with a WriteBlob Code... it is said that it would to what i need..
https://support.microsoft.com/en-us/help/210486/acc2000-reading--storing--and-writing-binary-large-objects-blobs
Now i can write Files to the Harddisc... but the files are still not able to open!
Something's wrong here...
My complete VBA Code is this:
Option Compare Database
Const BlockSize = 32768
Sub xxx()
Dim id As Integer
Debug.Print "****************************************************"
Debug.Print "****************************************************"
Debug.Print "****************************************************"
Debug.Print "****************************************************"
Dim unnoetig As Variant
Dim dok() As Byte
Dim sql As String
sql = "select top 1 idCaseDetail, idCase, Dokument from dbo_law_tbl_CaseHistory where idCaseDetail = ""1"""
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset(sql)
If Not rst.EOF Then
Do While Not rst.EOF
Debug.Print "idcasehistory: " & rst.Fields(0)
Debug.Print "idcase: " & rst.Fields(1)
If Not IsNull(rst.Fields(2).Value) Then
dok = rst.Fields(2)
unnoetig = WriteBLOB(rst, "Dokument", "c:\temp\ole.doc")
End If
rst.MoveNext
Loop
End If
End Sub
'**************************************************************
' FUNCTION: WriteBLOB()
'
' PURPOSE:
' Writes BLOB information stored in the specified table and field
' to the specified disk file.
'
' PREREQUISITES:
' The specified table with the OLE object field containing the
' binary data must be opened in Visual Basic code and the correct
' record navigated to prior to calling the WriteBLOB() function.
'
' ARGUMENTS:
' T - The table object containing the binary information.
' sField - The OLE object field in table T containing the
' binary information to write.
' Destination - The path and filename to write the binary
' information to.
'
' RETURN:
' The number of bytes written to the destination file.
'**************************************************************
Function WriteBLOB(T As DAO.Recordset, sField As String, _
Destination As String)
Dim NumBlocks As Integer, DestFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant
On Error GoTo Err_WriteBLOB
' Get the size of the field.
FileLength = T(sField).FieldSize()
If FileLength = 0 Then
WriteBLOB = 0
Exit Function
End If
' Calculate number of blocks to write and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' Remove any existing destination file.
DestFile = FreeFile
Open Destination For Output As DestFile
Close DestFile
' Open the destination file.
Open Destination For Binary As DestFile
' SysCmd is used to manipulate the status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, _
"Writing BLOB", FileLength / 1000)
' Write the leftover data to the output file.
FileData = T(sField).GetChunk(0, LeftOver)
Put DestFile, , FileData
' Update the status bar meter.
RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)
' Write the remaining blocks of data to the output file.
For i = 1 To NumBlocks
' Reads a chunk and writes it to output file.
FileData = T(sField).GetChunk((i - 1) * BlockSize _
+ LeftOver, BlockSize)
Put DestFile, , FileData
RetVal = SysCmd(acSysCmdUpdateMeter, _
((i - 1) * BlockSize + LeftOver) / 1000)
Next i
' Terminates function
RetVal = SysCmd(acSysCmdRemoveMeter)
Close DestFile
WriteBLOB = FileLength
Exit Function
Err_WriteBLOB:
WriteBLOB = -Err
Exit Function
End Function
Do you have any suggestions?
Important to say is:
It is an MS SQL Database... not an Access Database.. there are some tools which maybe could word with access-Databases.. but not mit ms sql
Is there a .NET way or an VBA way to save the files to disc?
An easy alternative to using DAO for saving OLE objects, is to use the ADODB.Stream object:
Public Sub SaveOLEObject(OleObjectField As Field, Filelocation As String)
Dim adoStream As Object 'ADODB.Stream
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Type = 1 'adTypeBinary
adoStream.Open
adoStream.Write OleObjectField.Value
adoStream.SaveToFile Filelocation, adSaveCreateOverWrite
adoStream.Close
End Sub
Call it:
SaveOLEObject(rst.Fields("Dokument"), "c:\temp\ole.doc")
Note that, of course, your documents might just be corrupt, and that might explain the problem.
If your objects are stored in SQL Server, I'd prefer directly opening an ADO recordset containing the binary data from SQL server over creating a linked table and opening a DAO recordset from the linked table.
In Access, create a corresponding Access Form with all relevant fields. Use the VBA code provided in the link and you should be able to export some of the most common file types in an automated fashion. Good luck.
https://medium.com/#haggenso/export-ole-fields-in-microsoft-access-c67d535c958d
I have a vb.net code and want to convert it in vb 6.0. But I have some difficulties. I cant find equivalent of some .net classes
Dim byteswritten As Integer
Dim fs As System.IO.FileStream
Dim r As System.IO.BinaryReader
Dim CHUNK_SIZE As Integer = 65554
fs = New System.IO.FileStream(filePath, System.IO.FileMode.Open, System.IO.FileAccess.Read)
r = New System.IO.BinaryReader(fs)
Dim FSize As Integer = CType(fs.Length, Integer)
Dim chunk() As Byte = r.ReadBytes(CHUNK_SIZE)
While (chunk.Length > 0)
dmPutStream.Write(chunk, chunk.Length, byteswritten)
If (FSize < CHUNK_SIZE) Then
CHUNK_SIZE = FSize
chunk = r.ReadBytes(CHUNK_SIZE)
Else
chunk = r.ReadBytes(CHUNK_SIZE)
End If
End While
Well, the document can be big then we used chunk. But I dont know steps for vb 6.0
Such as what i should do for binary reading.
Without all your code for opening the write stream and closing the read and write streams, here's an example of how you can do it in VB6 using ADODB.Stream.
Under Project | References, add a reference to ADO Active X Data Objects Library. My version is 6.1, but you should be okay to just choose the latest version - depends on what version of ADO is installed on your system
Hope it helps - more info online if you want to look at all the ADODB.Stream methods and properties
Public Sub StreamData(strWriteFilename As String, filePath As String)
Const CHUNK_SIZE As Long = 65554
Dim byteswritten As Integer
Dim FSize As Long
Dim adofs As New ADODB.Stream 'Object 'System.IO.FileStream
Dim varData As Variant
' Include this here - but probably defined elsewhere
Dim dmPutStream As New ADODB.Stream
' Open Write Stream
' *** Looks like you do this elsewhere
Set dmPutStream = CreateObject("ADODB.Stream")
With dmPutStream
.Type = adTypeBinary
.Open strWriteFilename, adModeWrite
End With
' Open Read strema and start pushing data from it to the write stream
Set adofs = CreateObject("ADODB.Stream") 'New System.IO.FileStream(filePath, System.IO.FileMode.Open, System.IO.FileAccess.Read)
With adofs
.Type = adTypeBinary
.Open
.LoadFromFile filePath
' Size of Read file - do you want this?
FSize = .Size
varData = .Read(CHUNK_SIZE)
Do While Len(varData) > 0
dmPutStream.Write varData
If Not .EOS Then
varData = .Read(CHUNK_SIZE)
End If
Loop
.Close
End With
'Save binary data To disk
dmPutStream.SaveToFile strWriteFilename, adSaveCreateOverWrite
dmPutStream.Close
End Sub
Converting VB.NET to VB6 is a bad idea, and completely unnecessary. If you need to use the VB.NET code from a VB6 application, the best thing to do would be to create a COM-visible wrapper for your .NET library, and call that wrapper from your VB6 application.
You probably CAN convert the code functionally with VB6, but there really is no point. VB.NET is a better language than VB6, use its COM capabilities to save you from writing endless sketchy VB6 code.
If you are dead set on doing this, you will need to reproduce the Stream and Reader classes functionally.
Here is the source for FileStream.cs:
http://referencesource.microsoft.com/#mscorlib/system/io/filestream.cs
And for BinaryReader:
http://referencesource.microsoft.com/#mscorlib/system/io/binaryreader.cs
Currently I'm doing project in vb.net and I want to set the progress bar while copying files from one folder to another. And the progress bar should move towards completion according to amount of file copied.
Not so new question, but here's an answer nonetheless. The following code will achieve the desired result whereby an individual file's progress is tracked. It uses a 1 MiB buffer. Depending on your system's resources, you can adjust the buffer accordingly to tweak the performance of the transfer.
Concept: Count each byte as it is read/written and report the progress based on the total size of the source file, using file streams.
'Create the file stream for the source file
Dim streamRead as New System.IO.FileStream([sourceFile], System.IO.FileMode.Open)
'Create the file stream for the destination file
Dim streamWrite as New System.IO.FileStream([targetFile], System.IO.FileMode.Create)
'Determine the size in bytes of the source file (-1 as our position starts at 0)
Dim lngLen as Long = streamRead.Length - 1
Dim byteBuffer(1048576) as Byte 'our stream buffer
Dim intBytesRead as Integer 'number of bytes read
While streamRead.Position < lngLen 'keep streaming until EOF
'Read from the Source
intBytesRead = (streamRead.Read(byteBuffer, 0, 1048576))
'Write to the Target
streamWrite.Write(byteBuffer, 0, intBytesRead)
'Display the progress
ProgressBar1.Value = CInt(streamRead.Position / lngLen * 100)
Application.DoEvents() 'do it
End While
'Clean up
streamWrite.Flush()
streamWrite.Close()
streamRead.Close()
Concept used: Get the count of files in the source directory, and then whenever copying a file from source folder to destination folder increment a variable to trace how many files get transferred. Now calculate the files transferred percentage by using the following formula,
% of files transferred = How many files Transferred * 100 / Total No of files in source folder
And then after getting the % of files transferred, update the progress bar's value by using it.
Try this code : Tested with IDE
Dim xNewLocataion = "E:\Test1"
Dim xFilesCount = Directory.GetFiles("E:\Test").Length
Dim xFilesTransferred As Integer = 0
For Each xFiles In Directory.GetFiles("E:\Test")
File.Copy(xFiles, xNewLocataion & "\" & Path.GetFileName(xFiles), True)
xFilesTransferred += 1
ProgressBar1.Value = xFilesTransferred * 100 / xFilesCount
ProgressBar1.Update()
Next
I want to store a unicode string in a flat file on a windows box from an excel/vba macro. The macro converts normal string to unicode representation, need to store it in a file and retrieve later.
As mentioned, you can use the Microsoft Scripting Runtime (scrrun.dll). I have posted some examples below. Some people also like the native file IO features. There is an extensive (and fairly comprehensive thread) thread here: http://www.xtremevbtalk.com/showthread.php?t=123814
However for Unicode files it's probably the least painful to use Textstreams:)
Public Sub StringToTextFile(ByVal path As String, ByVal value As String)
'Requires reference to scrrun.dll
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Set fso = New Scripting.FileSystemObject
Set ts = fso.CreateTextFile(path, False, True)
ts.Write value
ts.Close
End Sub
Public Sub LazyMansWay(ByVal path As String, ByVal value As String)
'Reference counting will cause the objects to be destroyed. The termination
'events of the classes will cause the connections to be closed.
CreateObject("Scripting.FileSystemObject").CreateTextFile(path, False, True).Write value
End Sub
Add a reference to "Microsoft Scripting Runtime" COM component (scrrun.dll).
It has all the classes (specifically FileSystemObject/TextStream) to create/read/write files.
The best solution I could figure is read the string in to a byte array and write each byte to a binary file
Private Function WriteBinaryFile(ByRef szData As String)
Dim bytData() As Byte
Dim lCount As Long
bytData = szData
Open PwdFileName For Binary As #1
For lCount = LBound(bytData) To UBound(bytData)
Put #1, , bytData(lCount)
Next lCount
Close #1
End Function
Read it back by opening the file in binary mode and reading each byte into a byte array and then converting it to a string.
Sub ReadBinaryFile(ByRef gszData As String)
Dim aryBytes() As Byte
Dim bytInput As Byte
Dim intFileNumber
Dim intFilePos
intFileNumber = FreeFile
Open PwdFileName For Binary As #intFileNumber
intFilePos = 1
Do
Get #intFileNumber, intFilePos, bytInput
If EOF(intFileNumber) = True Then Exit Do
ReDim Preserve aryBytes(intFilePos - 1)
aryBytes(UBound(aryBytes)) = bytInput
intFilePos = intFilePos + 1
Loop While EOF(intFileNumber) = False
Close #intFileNumber
gszData = aryBytes
End Sub