Cannot write the contents of an Object to file

[deltaquattro]

Hi,

I would like to write the contents of a Collection of Objects to a
file, but I'm having a lot of problems. Can you help me? Here's a
simplified version of my code, which reproduces the problem:

----------------
Main----------------------------------------------------------
Sub test()
Dim I As Long, Record As CRecord, Coll As Collection

Set Record = New CRecord
Set Coll = New Collection

For I = 1 To 26
Record.Linea(I) = "foobar" & I
Next I

Coll.Add Item:=Record

Call WriteDataToFile("foo.txt", Coll)

End Sub
--------------------------------------------------------------------------------------

The CRecord Class Module follows:

----CRecord
Class-------------------------------------------------------------
Option Explicit

Private pLinea(1 To 26) As String

' Left Limit Property
Public Property Get Linea(Index As Long) As String
Linea = pLinea(Index)
End Property
Public Property Let Linea(Index As Long, Value As String)
pLinea(Index) = Value
End Property

' PrintToFile Method
Public Function PrintToFile(FileUnit As Integer)
Dim I As Long
For I = 1 To NLines
Print #FileUnit, Linea(I)
Next I
End Function
----------------------------------------------------------------------------------------

Finally, here's the WriteDataToFile function:


-----------------------
WriteDataToFile--------------------------------------------------------------------------------------
Function WriteDataToFile(FileName As String, Container As Variant) As
Boolean
'Write each element contained in Container (either an array or a
collection) to file FileName
Dim FNumber As Integer, Element As Variant

'Find free file number
FNumber = FreeFile

'Create new file or overwrite existing one
Open FileName For Output As #FNumber

'Write array to file
For Each Element In Container
If IsObject(Element) Then
Element.PrintToFile FileUnit:=FNumber
Else
Print #FNumber, Element
End If
Next

'Close file and exit
Close #FNumber

End Function
---------------------------------------------------------------------------------


The error I get when running test() is
"Run-time error 52:

Bad file name or number"

However, the file name is an allowed one ("foo.txt") and the file
number is surely ok, since I get it using the intrinsic VB function
FreeFile, which returns an Integer corresponding to a free file
number. So I really don't know what's happening here. Can you help me?
Thanks,

Best Regards

deltaquattro

 

[Peter T]

Works fine for me although I did have to change
For I = 1 To NLines
to
For I = 1 To Ubound(pLinea)

I can see all sorts of problems ahead unless you are very careful, eg what
happens if/when
If IsObject(Element) Then
but Element doesn't have a method .PrintToFile

At the very least I'd suggest

on error goto errExit
FNumber = FreeFile

'code

done:
on error resume next
Close #FNumber

exit function
errExit:
resume done
end function

Another thought, "foo.txt"? The code would fail if the curDir doesn't have
access to write files (often a problem Vista / W7), why not qualify it, eg
application.defaultfilepath & "\foo.txt"

Regards,
Peter T

 

[deltaquattro]

Hi Peter,

thanks for your answer and your suggestions. However, I still have the
same error.
I found out that when test() and WriteDataToFile() are located in the
same Module1 inside the same workbook (for example Test.xls), and
CRecord is in the same workbook, then no problem occurs.
However, in my setup, is inside MyLibrary.xla, a collection of all
modules which I reuse in different projects, while Module1 (test())
and CRecord are inside Test.xls. MyLibrary.xla is added to the
References of Test.xls. In this case, I get the error:

"Run-time error 52:
Bad file name or number"

Should I give up on the idea of adding my more or less general data
writing function in to MyLibrary.xla? Or is there a way to get things
working? Thanks again,

Best Regards,

deltaquattro

 

[Peter T]

I don't quite follow what's in what but why not do it the way I suggested
last time. Give a method in each of your own objects to return a string to
your print routine. See the example I suggested in your previous thread on
this same subject.

Note particularly GetProps() In the example it returned 3 tab separated
values as a single string. But for your array you might want it to return
something like this

' in the class module
Public Function GetProps() As String
Dim i As Long
Dim s As String

For i = LBound(pLinea) To UBound(pLinea)
s = s & pLinea(i)
If i < UBound(pLinea) Then
s = s & vbCrLf
End If
Next
GetProps = s

' could add any other value/string properties here on the end
End Function

and call it from your pint routine amended something like this

Function WriteDataToFile(FileName As String, Container As Variant) As
Boolean
'Write each element contained in Container
'(either an array or a collection) to file FileName
Dim FNumber As Integer, Element As Variant

'Find free file number
On Error GoTo errH ' < new
FNumber = FreeFile

'Create new file or overwrite existing one
Open FileName For Output As #FNumber

'Write array to file
For Each Element In Container
If IsObject(Element) Then
'Element.PrintToFile FileUnit:=FNumber ' < comment
Print #FNumber, Element.GetProps ' < new
Else
Print #FNumber, Element
End If
Next

done: ' < new
On Error Resume Next ' < new
'Close file and exit
Close #FNumber
Exit Function ' < new
errH: ' < new
Resume done ' < new

End Function

FWIW, personally I'd wouldn't want an all purpose print routine like this.
Determine what "container" is before sending it to any print routine and
cater accordingly

Regards,
Peter T


Hi Peter,

thanks for your answer and your suggestions. However, I still have the
same error.
I found out that when test() and WriteDataToFile() are located in the
same Module1 inside the same workbook (for example Test.xls), and
CRecord is in the same workbook, then no problem occurs.
However, in my setup, is inside MyLibrary.xla, a collection of all
modules which I reuse in different projects, while Module1 (test())
and CRecord are inside Test.xls. MyLibrary.xla is added to the
References of Test.xls. In this case, I get the error:

"Run-time error 52:
Bad file name or number"

Should I give up on the idea of adding my more or less general data
writing function in to MyLibrary.xla? Or is there a way to get things
working? Thanks again,

Best Regards,

deltaquattro

 

[deltaquattro]

Hi Peter,

I didn't do as you suggested last time, for two simple reasons:
1. I didn't get the point of returning all props as a single string,
but, seeing your example, I understand that, this way, I can use the
classic Print # statement. Clever!
2. I thought that GetProps() would return all properties on a single
line, but each CRecord must instead be written on file as
UBound(pLinea)=26 consecutive lines of text. This is a requirement of
the code which will then read the file, so I cannot alter this.
However, after reading your following example I understood that I can
write the contents of CRecord on separate lines thanks to VBCrLf
(didn't know about that!). I will try implementing your idea and see
if it works fine for me. Thnx!

Best Regards

deltaquattro

 

[Peter T]

It sounds like you've got the idea!

One thing though, if building a very large string, say by looping a large
array, size the string first, s=Space(nSize) then pad it with the Mid
function (don't forget to include 2*(loops-1) for the vbCrLF characters. Ask
if not sure how (but only if building a long string in many loops).

Regards,
Peter T


Hi Peter,

I didn't do as you suggested last time, for two simple reasons:
1. I didn't get the point of returning all props as a single string,
but, seeing your example, I understand that, this way, I can use the
classic Print # statement. Clever!
2. I thought that GetProps() would return all properties on a single
line, but each CRecord must instead be written on file as
UBound(pLinea)=26 consecutive lines of text. This is a requirement of
the code which will then read the file, so I cannot alter this.
However, after reading your following example I understood that I can
write the contents of CRecord on separate lines thanks to VBCrLf
(didn't know about that!). I will try implementing your idea and see
if it works fine for me. Thnx!

Best Regards

deltaquattro

 

[deltaquattro]

It sounds like you've got the idea!

yes, thanks to your very clear examples.

One thing though, if building a very large string, say by looping a large
array, size the string first, s=Space(nSize) then pad it with the Mid
function (don't forget to include 2*(loops-1) for the vbCrLF characters. Ask
if not sure how (but only if building a long string in many loops).

The array in my real code can indeed be large (in the example I fixed
the number of lines to 26 but it can be much more). What do you mean
by padding with Mid function? Could you write an example? Thanks,

Best Regards

deltaquattro

 

[Peter T]

I wouldn't worry about 26 lines but over a few thousand and the speed can
slow exponentially. This should give you quite a dramatic illustration

Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub test()
Dim i As Long, pos As Long, nLen As Long, t As Long
Dim s1 As String, s2 As String
Const C As Long = (20000 - 1)

ReDim arr(0 To C) As String
' build a test array
For i = LBound(arr) To UBound(arr)
Select Case i Mod 4
Case 0: arr(i) = "a"
Case 1: arr(i) = "bb"
Case 2: arr(i) = "ccc"
Case 3: arr(i) = "dddd"
End Select
Next

'' padded Mid way
t = GetTickCount
For i = LBound(arr) To UBound(arr)
nLen = nLen + Len(arr(i))
Next

' add +2 for each vbCrLF
nLen = nLen + (UBound(arr) - LBound(arr)) * 2

s1 = Space(nLen) ' size the string
pos = 1
For i = LBound(arr) To UBound(arr)
Mid$(s1, pos, Len(arr(i))) = arr(i)
pos = pos + Len(arr(i))
If i < UBound(arr) Then
Mid$(s1, pos, 2) = vbCrLf
pos = pos + 2
End If
Next
Debug.Print Len(s1), (GetTickCount - t) / 1000

' now the simple way
t = GetTickCount
For i = LBound(arr) To UBound(arr)
s2 = s2 & arr(i)
If i < UBound(arr) Then
s2 = s2 & vbCrLf
End If
Next
Debug.Print Len(s2), (GetTickCount - t) / 1000

End Sub

Regards,
Peter T