Question: Appending a File to another file

[Kevin Brown]

I have the following code below.

Dim x As Integer
Dim lngFileLength As Long
Dim lngLoop as Long
Dim FileByte As Byte

Open OutFileName For Binary As #1
For x = 1 To colFilesList.Count 'just a collection of filenames
Open colFilesList.Item(x) For Binary As #2
lngFileLength = LOF(2)
For lngLoop = 0 To lngFileLength - 1
Get #2, , FileByte
Put #1, , FileByte
Next lngLoop
Close #2
Next x
Close #1

This works but I was wondering if it is possible to speed it up
somehow? I think reading 4 bytes (32bits) at time would probably speed
it up but I don't have clue or know if it is possible to read more
than a byte.

Thanks

Kevin Brown

Please reply to kev...@datex.ca and this newsgroup is possible.
Thanks.

[AnhMy Tran]

> Dim x As Integer
> Dim lngFileLength As Long
> Dim lngLoop as Long

> Dim FileByte As String ' Change it from Byte to String
>
FileByte = "AABB" ' Add this line if you want to read 4 bytes only
FileByte = "123456789" ' Add this line if you want to read 9 bytes

> Open OutFileName For Binary As #1
> For x = 1 To colFilesList.Count 'just a collection of filenames
> Open colFilesList.Item(x) For Binary As #2
> lngFileLength = LOF(2)

lngLoop = 1 ' add this line, starting reading at 1st position
Do While(lngLoop < lngFileLength) ' add this line
> 'For lngLoop = 0 To lngFileLength - 1 Delete or comment it out
> Get #2, lngLoop, FileByte ' modify it with lngLoop
> Put #1, lngLoop, FileByte ' modify it with lngLoop
lngLoop = lngLoop + Len(FileByte) ' add this line
> Loop ' Edit it

> Close #2
> Next x
> Close #1

I have a sample test with only the inner open, read and write that works.
I am not sure with your outter Loop with x. It is your responsible to test.

--
Posted via CNET Help.com
http://www.help.com/

[AnhMy Tran]

The following is the source code:

Option Explicit

Private Sub cmdRun_Click()

Dim x As Integer
Dim lngFileLength As Long

Dim lngLoop As Long
Dim FileByte As String

FileByte = "AABB"
Open "C:\temp\btest.txt" For Binary As #1
Open "C:\temp\atest.txt" For Binary As #2

lngFileLength = LOF(2)
lngLoop = 1

Do While (lngLoop < lngFileLength)
Get #2, lngLoop, FileByte
Put #1, lngLoop, FileByte
MsgBox FileByte

lngLoop = lngLoop + Len(FileByte)

Loop
Close #2
Close #1
End Sub

The following is the Test Input and output file:
"Aa
Bb
Cc
DdEeFfGg"
The message box displays Aa, Bb, Cc, DdEe and FfGg,
for the first record is AA and vbNewLine, the last record is FfGg without
vbNewLine.

[Matt Sargent]

Shell out to DOS and do it from there. You will be amazed at the speed
difference:

copy /b FirstFile+SecondFile ResultFile

On Wed, 23 Feb 2000 16:55:31 GMT, kev...@datex.ca (Kevin Brown) wrote:

>I have the following code below.
>

> Dim x As Integer
> Dim lngFileLength As Long

> Dim lngLoop as Long
> Dim FileByte As Byte

>
> Open OutFileName For Binary As #1
> For x = 1 To colFilesList.Count 'just a collection of filenames

> Open colFilesList.Item(x) For Binary As #2
> lngFileLength = LOF(2)

> For lngLoop = 0 To lngFileLength - 1

> Get #2, , FileByte
> Put #1, , FileByte
> Next lngLoop

> Close #2
> Next x
> Close #1
>

[Larry Serflaten]

This isn't exactly what you're after, but using it as an example, you
could rewrite it into an AppendFiles routine.

Maybe I'll make one too, and post it in a new thread to 'compare notes'.

HTH
LFS

Public Function CopyFile(src As String, dst As String) As Double
' L. F. Serflaten 1996 - rev. 2000
' Description:
' This routine will copy a file while providing a means to support a percent gauge.

' Inputs:
' src = Source file name (including path if necessary)
' dst = Destination file name (including path if necessary)

' Returns:
' The function returns the size of the original file on success, 0 on failure.

' If the destination file already exists, a message box will prompt the user.
' Error support is provided.

Dim BytesRemaining#, Fsize As Double
Dim Fsrc&, Fdst As Long
Const kBufferSize = 524288 'Larger is better, watch out for page swapping

'Trap errors
On Error GoTo FileCopyError

'Test file names
If Len(Dir(src)) = 0 Then MsgBox "File not found": Exit Function

If Len(Dir(dst)) <> 0 Then
If MsgBox(UCase$(dst) & vbCrLf & "File exists. Overwrite?", vbYesNo) = vbNo Then Exit Function
Kill dst
End If

'Init Files
Fsrc = FreeFile
Open src For Binary As Fsrc
Fdst = FreeFile
Open dst For Binary As Fdst
'Init variables
Fsize = LOF(Fsrc)
BytesRemaining = Fsize
'Init buffer
ReDim Buf(1 To kBufferSize) As Byte

Do While BytesRemaining > 0
'Adjust buffer (Last time through)
If BytesRemaining < kBufferSize Then
ReDim Buf(1 To BytesRemaining) As Byte
End If

'Copy one buffer full
Get Fsrc, , Buf
Put Fdst, , Buf
BytesRemaining = Fsize - LOF(Fdst) ' Or use: Fsize - UBound(Buf)

' __Call percent display here__
'PercentDone.Caption = ( 100 - Int(100 * BytesRemaining/Fsize) )
'PercentDone.Refresh
Loop

'Clean up and go
CopyFile = Fsize

FileCopyError:
Close Fsrc
Close Fdst
Erase Buf
If Err.Number Then MsgBox Err.Description
End Function

[Larry Serflaten]

Here's what I came up with:

AppendFiles <dest>, <file1> [,<filex>]

or:

DestFileSize = AppendFiles(<dest>, <file1> [,<filex>])

You may want to alter the response when the destination file already
exists, as shown it aborts if the user selects not to overwrite.

LFS

Public Function AppendFiles(dst As String, ParamArray src()) As Double

Dim BytesRemaining#, Fsize As Double
Dim Fsrc&, Fdst As Long

Dim NextFile As Long

'Larger is better, watch out for page swapping

Const kBufferSize = 524288

' L. F. Serflaten 1996 - rev. 2000
' Description:

' This routine will appends several files into one
' Inputs:

' dst = Destination file name (including path if necessary)

' src = One or more source file names (including path if necessary)
' Returns:
' The size of the destination file on success, 0 on failure.

' If the destination file already exists, a message box will prompt the user.
' Error support is provided.

'Trap errors
On Error GoTo AppendFilesError
'Test destination file

If Len(Dir(dst)) <> 0 Then
If MsgBox(UCase$(dst) & vbCrLf & "File exists. Overwrite?", vbYesNo) = vbNo Then Exit Function
Kill dst
End If

Screen.MousePointer = vbHourglass
'Init Files

Fdst = FreeFile
Open dst For Binary As Fdst

For NextFile = 0 To UBound(src)
Fsrc = FreeFile
Open src(NextFile) For Binary As Fsrc

'Init variables
Fsize = LOF(Fsrc)
BytesRemaining = Fsize
'Init buffer

ReDim buf(1 To kBufferSize) As Byte

Do While BytesRemaining > 0
'Adjust buffer (Last time through)
If BytesRemaining < kBufferSize Then

ReDim buf(1 To BytesRemaining) As Byte

End If
'Copy one buffer full

Get Fsrc, , buf
Put Fdst, , buf
BytesRemaining = Fsize - UBound(buf)
Loop
If buf(UBound(buf)) <> 10 Then Put Fdst, , vbCrLf
Close Fsrc
Next NextFile

'Clean up and go
AppendFiles = LOF(Fdst)

AppendFilesError:
Screen.MousePointer = vbDefault
Close Fdst, Fsrc
Erase buf