VB6 detect if a text file have text in it or not.

Hi Experts,

I would like to programmatically detect if a text file have text in it, if not,
then delete the file. I made something that detect if the file is 0 bytes, but
that doesn't work very well, Now I would like to detect if a text file have text in it.
Thanks in advance.
Samuel-AMCAsked:
Who is Participating?
 
eemitConnect With a Mentor Commented:
The same functionality as last Version but concatenate and delete separated into two functions.
(do not forget Project References)

Private Sub Command1_Click()
  On Error GoTo Err_Handler
  
  Dim sFilePath As String
  Dim sSeparator As String
  
  sFilePath = "C:\"  'change to your File Path
  sSeparator = vbNewLine & "#FilePath#" & vbNewLine
  
  ConcatenateMyFiles sFilePath, "MySystem.dat", sSeparator, "WP.txt", "BS.txt", "CO.txt", "FF.txt", "GC.txt", "IE.txt", "MN.txt", "NS.txt", "NT.txt", "OA.txt", "RR.txt", "SS.txt"
  DeleteMyEmptyFiles sFilePath, "WP.txt", "BS.txt", "CO.txt", "FF.txt", "GC.txt", "IE.txt", "MN.txt", "NS.txt", "NT.txt", "OA.txt", "RR.txt", "SS.txt"
  
  'End
  
  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (Command1_Click): " & Err.Description & ", " & CStr(Err.Number)

End Sub

Private Sub ConcatenateMyFiles( _
                    ByVal sFilePath As String, _
                    ByVal ResultFile As String, _
                    ByVal Separator As String, _
                    ParamArray SourceFiles() As Variant _
                    )
                    
  On Error GoTo Err_Handler
  
  Dim FSO As FileSystemObject
  Set FSO = New FileSystemObject
  
  Dim fsSourceStream As TextStream
  Dim fsResStream As TextStream
  Dim sSeparator As String
  Dim i As Integer
  
  Set fsResStream = FSO.OpenTextFile(sFilePath & ResultFile, ForWriting, True)
  For i = 0 To UBound(SourceFiles)
      sSeparator = Replace(Separator, "#FilePath#", SourceFiles(i))
      
      fsResStream.Write sSeparator & vbCrLf
      
      If FSO.FileExists(sFilePath & SourceFiles(i)) Then
          Set fsSourceStream = FSO.OpenTextFile(sFilePath & SourceFiles(i), ForReading, False, TristateUseDefault)
          If fsSourceStream.AtEndOfStream Then
              fsResStream.Write "File is empty" & vbCrLf
          Else
              fsResStream.Write fsSourceStream.ReadAll & vbCrLf
          End If
          fsSourceStream.Close
          Set fsSourceStream = Nothing
      Else
          fsResStream.Write "File not found" & vbCrLf
      End If
  Next i
  fsResStream.Close
  
  Set fsSourceStream = Nothing
  Set fsResStream = Nothing
  Set FSO = Nothing
  
  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (ConcatenateMyFiles): " & Err.Description & ", " & CStr(Err.Number)
  Resume Next
  
End Sub

Private Sub DeleteMyEmptyFiles( _
                    ByVal sFilePath As String, _
                    ParamArray SourceFiles() As Variant _
                    )
                    
  On Error GoTo Err_Handler
  
  Dim FSO As FileSystemObject
  Set FSO = New FileSystemObject
  
  Dim fsSourceStream As TextStream
  Dim i As Integer
  
  For i = 0 To UBound(SourceFiles)
      If FSO.FileExists(sFilePath & SourceFiles(i)) Then
          Set fsSourceStream = FSO.OpenTextFile(sFilePath & SourceFiles(i), ForReading, False, TristateUseDefault)

          If fsSourceStream.AtEndOfStream Then
              fsSourceStream.Close
              Set fsSourceStream = Nothing
              FSO.DeleteFile sFilePath & SourceFiles(i)
          Else
              fsSourceStream.Close
              Set fsSourceStream = Nothing
          End If
          
      End If
  Next i
  
  Set fsSourceStream = Nothing
  Set FSO = Nothing
  
  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (DeleteMyEmptyFiles): " & Err.Description & ", " & CStr(Err.Number)
  Resume Next
  
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Open "C:\temp\empty.txt" For Input As #1

If EOF(1) Then
    MsgBox "Empty"
    Kill "C:\temp\empty.txt"
End If
0
 
Samuel-AMCAuthor Commented:
Thanks Martin, let me explain a bit more...
I have a batch file that search the system for few things, like the one that
gets the system info and so on, okay, in total my batch generate 12 text files
in total, but these files not always return with info, some of them sometimes
return with nothing, then inside the folder there are these 12 files, and manually
I have to delete the ones that are zero text, so that is why I came across this idea.
My idea is to run my batch, then when the batch task is done, at the end of my batch
the batch will run my tool to check on those emty files and if they have no text in it,
then they should be delete it.
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
Martin LissOlder than dirtCommented:
Okay so what do you need help with, because my code will remove a single file and can be adapted to do a loop?
0
 
Samuel-AMCAuthor Commented:
Martin, I need a way to delete a file if the file don't have text in it.
for example, suppose I just create a text file lacated in C:\Tets,txt.
Then I was wondering if the project can check on that file.

so forget about the batch and all the other things I mentioned.
Thanks Martin
0
 
Martin LissOlder than dirtCommented:
That's what my code in post ID: 38817156 does.
0
 
Samuel-AMCAuthor Commented:
Martin, but I tought this can only work if the file were created from the same
app file that created the file that we are trying to located and check if there is text.
0
 
Martin LissOlder than dirtCommented:
All you need is the path to the file.
0
 
Samuel-AMCAuthor Commented:
Okay Martin, I tried, and this what I get:

Private Sub Command1_Click()
Open "C:\test.txt" For Input As #1
If EOF(1) Then
Kill "C:\test.txt"
End If
End Sub

Run-time error '55':
File already open


File already open? but I did not opened the file.
I tried in two ways, I added some text to the file, and nothing happended,
which is okay, but then tried again, and even if the file have some text in it,
I get the run-time error. then I tried with no text in the file, and still get the error.
0
 
Martin LissOlder than dirtCommented:
Private Sub Command1_Click()
Open "C:\test.txt" For Input As #1
If EOF(1) Then
Close
Kill "C:\test.txt"
End If
End Sub
0
 
Samuel-AMCAuthor Commented:
Martin, this time it did worked, but some how I still get the error.
Let me explain, since I'm testing the project, if I press the button two times,
I get the error, okay if there is no text in the file, the file get deleted, which is ok,
If I add text to the file, nothing happend, the file does not get deleted, but if I hit
the button one more time, I mean, if I just hit the button two times I get the error.
the run-time error.
0
 
Samuel-AMCAuthor Commented:
Is okay Martin, I added:
On Error Resume Next
And now I don't get the run-time error.
Do you think this is okay? thanks Martin.
0
 
Samuel-AMCAuthor Commented:
Martin, one last question...
I need to apply this to 12 files, how could I set this code for the 12 files?
I mean, I don't want to re-create the code 12 times, if you know what I mean.
Private Sub Command1_Click()
Open "C:\test-1.txt" For Input As #1
Open "C:\test-2.txt" For Input As #1
Open "C:\test-3.txt" For Input As #1
If EOF(1) Then
Close
Kill "C:\test-1.txt"
Kill "C:\test-2.txt"
Kill "C:\test-3.txt"

AND SO ON

End If
End Sub

Open in new window

0
 
Martin LissOlder than dirtCommented:
Well what you wrote won't work, but let me ask, will all the files have names like that? In other words will they all be something like xxx1.txt, xxx2.txt, etc?
0
 
Martin LissOlder than dirtCommented:
If so, then...

Private Sub Command1_Click()
Dim intNum As Integer

For intNum = 1 to 12
    Open "C:\test-" & intNum & ".txt" For Input As #1    
    If EOF(1) Then
        Kill "C:\test-" & intNum & ".txt"
    End If
    Close
Next
End Sub

Open in new window

0
 
Samuel-AMCAuthor Commented:
Thanks Martin, the names are like:
SS.txt, NT.txt, OC.txt, WP.txt, and so on.
0
 
Samuel-AMCAuthor Commented:
This is my total file in their order:
BS, CO, FF, GC, IE, MN, NS, NT, OA, RR, SS, WP.
0
 
Martin LissOlder than dirtCommented:
Private Sub Command1_Click()
Dim intNum As Integer
Dim strNames()
strNames = Array("BS", "CO", "FF", "GC", "IE", "MN", "NS", "NT", "OA", "RR", "SS", "WP")
For intNum = 0 to 11
    Open "C:\" & strNames(intNum) & ".txt" For Input As #1    
    If EOF(1) Then
        Kill "C:\" & strNames(intNum) & ".txt"
    End If
    Close
Next
End Sub

Open in new window

0
 
Samuel-AMCAuthor Commented:
Martin, this time it does not kill anything :-(
There are many of these files with no text in it,
But it did not killed any of the files with no text.
0
 
Martin LissOlder than dirtCommented:
Do you still have On Error Resume Next in your code? If so remove it and tell me what happens.
0
 
Samuel-AMCAuthor Commented:
I added, but thats not the problem, the issue is that now none of the files get deleted.
0
 
Martin LissOlder than dirtCommented:
I'm sorry but what I asked you to do was to REMOVE the On Error Resume Nexl line.  I asked you to do that so if there's an error we can see what it is. Also please show the exact code you are using.
0
 
Samuel-AMCAuthor Commented:
Martin, there no code to show, the code I'm working with is with your vb code thats all, the if I remove the "on error resume next" then I get the run-time error. but even with out it This time your code does not delete none of the files on C:\
0
 
Martin LissOlder than dirtCommented:
What EXACTLY is the error that you get when you remove the On Error Resume Next line?
0
 
Samuel-AMCAuthor Commented:
The same error as before:
run-time error '55'
File already open.
but I can get rid of this, but the main thing now is not that error, the problem now is that the vb code is not deleting any file at all.
0
 
Martin LissOlder than dirtCommented:
Please show the code you are using (even if it's mine).
0
 
Samuel-AMCAuthor Commented:
Private Sub Command1_Click()
On Error Resume Next
Dim intNum As Integer
Dim strNames()
strNames = Array("BS", "CO", "FF", "GC", "IE", "MN", "NS", "NT", "OA", "RR", "SS", "WP")
For intNum = 1 To 12
Open "C:\" & strNames(intNum) & ".txt" For Input As #1
If EOF(1) Then
Kill "C:\" & strNames(intNum) & ".txt"
End If
Close
Next
End Sub

Open in new window


Then if I use it without the "On Error Resume Next"
I get the Run-time error "55".
0
 
Samuel-AMCAuthor Commented:
I could use the code from before, as it work perfect, this code:

Private Sub Command1_Click()
On Error Resume Next
Open "C:\test.txt" For Input As #1

If EOF(1) Then
Close
Kill "C:\test.txt"
End If
End Sub

But I will have to repeat it 12 times and thats what I was trying to avoid.
But again, this other code still show the Run-time error "55". so that is why
I added the "On Error Resume Next".
0
 
Martin LissConnect With a Mentor Older than dirtCommented:
Okay this will work. Notice the 0 to 11 and the added Close at line 7.

Dim intNum As Integer
Dim strNames()
strNames = Array("BS", "CO", "FF", "GC", "IE", "MN", "NS", "NT", "OA", "RR", "SS", "WP")
For intNum = 0 To 11
    Open "C:\" & strNames(intNum) & ".txt" For Input As #1
    If EOF(1) Then
        Close
        Kill "C:\" & strNames(intNum) & ".txt"
    End If
    Close
Next

Open in new window

0
 
Samuel-AMCAuthor Commented:
Yes Martin, this time it did delete some files, but let me explain,
there were three files with no text in it that were not delted.
then I tried to hit the button again for a second click and got this error:
Run-time error '53':
File not found
0
 
Samuel-AMCAuthor Commented:
These are the empty files that were not deleted: FF.txt, OAtxt, RR.txt
I then added the "On Error Resume Next" to avoid the run-time error.
But even if I repeat the detection by pressing the button several times
I don't get those empty files to be deleted.
0
 
Martin LissOlder than dirtCommented:
1. If they are really empty they will be deleted. To be sure, look at one of the files in a hex editor. You could also attach one of the files that does't get deleted so I can look at it.

2. There's no reason to run the code twice. If the file wasn't deleted the first time it won't be deleted the second. If you do run the code twice then some of the files won't be there and you should use On Error  Resume Next.

I'm going to sleep and will get back to you tomorrow.
0
 
Samuel-AMCAuthor Commented:
Okay thanks Martin, I will do that when you get back tomorrow.
Thank you
0
 
Samuel-AMCAuthor Commented:
You are right Martin, the files that cannot be deleted are empty,
But I'm checking them with a Hex file editor and I see there is some
data in the file, but the wird thing is that if you look at the file in the
folder where I have them right now, from the three files that cannot
be delete, on one of them it shows 0 bytes, there is only one that is
showing 2kb but is also empty, blank 100%
0
 
eemitCommented:
1)
Never use
      Open...As #1
Always obtain next available file number using FreeFile Function e.g.:
      Dim nFileNum As Integer
      nFileNum = FreeFile
      Open ...As #nFileNum
      If EOF(nFileNum) Then

2)
Try this:
 
Dim intNum As Integer
  Dim strNames()
  strNames = Array("BS", "CO", "FF", "GC", "IE", "MN", "NS", "NT", "OA", "RR", "SS", "WP")
  
  For intNum = 0 To 11
      nFileNum = FreeFile
    
      If FileExists("C:\" & strNames(intNum) & ".txt") Then
          ' FileLen returns file size in bytes
          If FileLen("C:\" & strNames(intNum) & ".txt") = 0 Then
              Kill "C:\" & strNames(intNum) & ".txt"
          End If
      End If

  Next

End Sub

Private Function FileExists(ByVal fname As String) As Boolean
  On Error Resume Next
  FileExists = (GetAttr(fname) And vbDirectory) = vbNormal
End Function

Open in new window

0
 
Samuel-AMCAuthor Commented:
Hi eemit, Martin code works okay, but thanks for your suggestion...
I just tried your code example, and yes, it does work very well, thank you.
But would be nice if you could suggest me what I could do to get arround with
the files that could not be deleted due to a very small invisible data in the files.
let me explain, the idea here is to delete only the files with zero text, and lieve
alone the one's with text. Martin suggested me to take a look at these files with
a hex editor which I did and he was right, some of these files have a very small
portion of data, they look like two symbol letters which I would like to find out
if there is a way to kill them as well, cuz if I open the file, is all blank, empty.
Thank you eemit for looking at my question.
0
 
Martin LissOlder than dirtCommented:
Please attach one of the files that has the the very small portion of data.
0
 
Samuel-AMCAuthor Commented:
Thanks Martin, with the hex editor this is what I see on this text file: ÿþ
FF.txt
0
 
Martin LissOlder than dirtCommented:
Sorry, but could you please enclose that file in either a zip or rar file. The way it is my browsers insist on opening it in the browser.
0
 
Samuel-AMCAuthor Commented:
Oh mybad Martin, here is a .rar file, thanks.
Do me only one favor, rename the file extention to .rar,
EE did not allowed me to attach such file as a .rar, so I ziped as a .rar,
and then changed format to .txt, thanks Martin
FF.txt
0
 
Martin LissOlder than dirtCommented:
That doesn't work. The browser thinks it's a text file and opens it. Please change it to FF.xyz or something and attach it agin.
0
 
Samuel-AMCAuthor Commented:
Hold on Martin, this will be the same thing to you :-D let me Zipped for you
instead of rar, sorry
0
 
Samuel-AMCAuthor Commented:
Okay, here is a Zip file
FF.zip
0
 
Martin LissOlder than dirtCommented:
Try this


Dim intNum As Integer
Dim strNames()
Dim str As String

strNames = Array("BS", "CO", "FF", "GC", "IE", "MN", "NS", "NT", "OA", "RR", "SS", "WP")
For intNum = 0 To 11
    Open "C:\" & strNames(intNum) & ".txt" For Input As #1
    If EOF(1) Then
        Close
        Kill "C:\" & strNames(intNum) & ".txt"
    Else
        Line Input #1, str
        If Asc(Mid(str, 1, 1)) = 254 Or Asc(Mid(str, 1, 1)) = 255 Then
            Close
            Kill "C:\" & strNames(intNum) & ".txt"
        End If
    End If
    Close
Next

Open in new window

0
 
Samuel-AMCAuthor Commented:
Martin, there are 5 files with text, and 7 with no text, but the code delete 9 files,
Leaving me with only 3 files with text, so in conclution the code deleted files with
text this time. and that file, the FF.txt, yeah, it was deleted this time which is fine,
but some good files with text got also deleted.
0
 
Samuel-AMCAuthor Commented:
Martin, thank you for your help, I will be back to this question later,
I have to go now, thank you so much.
0
 
Martin LissOlder than dirtCommented:
Please attach the 3 files (in one zip is good) that you have a problem with.
0
 
Samuel-AMCAuthor Commented:
I'm back Martin, here are the files, but I was thinking one thing, right now I have
only three files with this problem, but how about if I get this same issue in the
future with all the files? some times the files are not able to return info with it,
and for what I see in these three files, the three files have the same exact data,
they have the same exact symbols on it, and I was thinking or wondering how
the other files get deleted after you updated your code, it might be that because
point to the code to delete these files base on some soft amount of data  and not
by whats in the file "If Asc(Mid(str, 1, 1)) = 254 Or Asc(Mid(str, 1, 1)) = 255 Then".
Files.zip
0
 
Martin LissOlder than dirtCommented:
I incorporated some of eemit's code.


Sub YourSub()
Dim intNum As Integer
Dim strNames()
Dim str As String

On Error GoTo ErrorRoutine
strNames = Array("BS", "CO", "FF", "GC", "IE", "MN", "NS", "NT", "OA", "RR", "SS", "WP")
For intNum = 0 To 11
    If FileExists("C:\" & strNames(intNum) & ".txt") Then
        Open "C:\" & strNames(intNum) & ".txt" For Input As #1
        If EOF(1) Then
            Close
            Kill "C:\" & strNames(intNum) & ".txt"
        Else
            Line Input #1, str
            If Asc(Mid(str, 1, 1)) = 255 Or Len(str) < 3 Then
                Close
                Kill "C:\" & strNames(intNum) & ".txt"
            End If
        End If
        Close
    End If
Next
Exit Sub
ErrorRoutine:
    If Err.Number = 55 Then
        ' file is already open
        Close
        Resume
    End If
End Sub

Private Function FileExists(ByVal fname As String) As Boolean
  On Error Resume Next
  FileExists = (GetAttr(fname) And vbDirectory) = vbNormal

End Function

Open in new window

0
 
Samuel-AMCAuthor Commented:
Martin, still the same as the code before, this code delete 9 files from the 12.
0
 
Martin LissOlder than dirtCommented:
Do it twice and see what happens.
0
 
Samuel-AMCAuthor Commented:
Martin, it does it at once, I mean, it kills all the 9 files from the 12.
0
 
Martin LissOlder than dirtCommented:
I'm sorry but I don't know what that means. Do you still have a problem? If so I'm out of ideas.
0
 
Samuel-AMCAuthor Commented:
I understand Martin, me too, I'm also out of ideas, I will continue using it as usual.
I mean, with no code or this project I've been working on, thanks for your help Martin.
0
 
Samuel-AMCAuthor Commented:
The only thing that I was wondering is...
That would be nice if there was a code that could detect if there is really text or not
in a text document. because there could be a text document with spaces and with no
text on it, but with data on it due to the generate spaces, then if that the case, thats
when a code to detect only text would come in handy. :-) but such code or such way
does not exist, thank you for all your help Martin.
0
 
eemitCommented:
If it is always the same content you can rename one of these files to e.g.
"dummy_empty.txt" and compare two files to determine if they are Identical.

          If FileLen("C:\" & strNames(intNum) & ".txt") = 0 Then
              Kill "C:\" & strNames(intNum) & ".txt"
          ElseIf AreFilesTheSame("C:\" & strNames(intNum) & ".txt", "C:\" & "dummy_empty.txt", True) Then
              Kill "C:\" & strNames(intNum) & ".txt"
          End If

Open in new window


You can Download code for function AreFilesTheSame here.

NOTE: It seams that 'FF FE' sequence is Byte order mark by Unicode files.
Byte order mark
    FF FE
Description
    UTF-16, little endian
0
 
Samuel-AMCAuthor Commented:
Martin, eemit,

I wanted to tell you guys a little something about this project,
this is something that I've been trying to do for a while but without been
able to put anything together, but this is another part of the same project.
so this is what I've tried before, since I could not get arround on how to delete
only the files that didn't have no text, I came out with this idea, the idea was to
merge all the 12 files into one, but there was another problem, after all the files
joined together in few of the output text there were missing context of some files,
not that much, but yeah, I was not that happy with that, so I went back to the same
method, so this is the code to merge all the files together:
Private Sub ConcatenateFiles(ByVal ResultFile As String, ByVal Separator As String, ParamArray SourceFiles() As Variant)
Dim FSO As New FileSystemObject
Dim fsSourceStream As TextStream
Dim fsResStream As TextStream
Dim sSeparator As String
Dim i As Integer
On Error Resume Next
Set fsResStream = FSO.OpenTextFile(ResultFile, ForWriting, True)
For i = 0 To UBound(SourceFiles)
sSeparator = Replace(Separator, "#FilePath#", SourceFiles(i))
fsResStream.Write sSeparator & vbCrLf
Set fsSourceStream = FSO.OpenTextFile(SourceFiles(i), ForReading)
fsResStream.Write fsSourceStream.ReadAll & vbCrLf
fsSourceStream.Close
Next i
fsResStream.Close
End Sub

Private Sub Command1_Click()
ConcatenateFiles "System.dat", vbNewLine & "", vbNewLine & "WP.txt", "BS.txt", "CO.txt", "FF.txt", "GC.txt", "IE.txt", "MN.txt", "NS.txt", "NT.txt", "OA.txt", "RR.txt", "SS.txt"
Kill "WP.txt"
Kill "BS.txt"
Kill "CO.txt"
Kill "FF.txt"
Kill "GC.txt"
Kill "IE.txt"
Kill "MN.txt"
Kill "NS.txt"
Kill "NT.txt"
Kill "OA.txt"
Kill "RR.txt"
Kill "SS.txt"
End
End Sub

Open in new window

Then after everything is in one new single file, all the 12 files can now be delete.
0
 
Samuel-AMCAuthor Commented:
Let me know what you guys think about this other method, thanks.
0
 
eemitCommented:
since I could not get arround on how to delete
only the files that didn't have no text, I came out with this idea

Answer I've posted in ID: 38821132 should work well!
0
 
aikimarkCommented:
I think the 55 error was an artifact from a prior run, where the file was not closed.  A logoff/logon should reset that condition.  If not, reboot.

A better approach might be to use the FileLen() function to check the length of the file.  This avoids Open conflicts and is faster than Open/Close.  Alternatively, you can use a FileSystemObject variable to check the length of a file without opening the file.
0
 
Samuel-AMCAuthor Commented:
aikimark:
"A logoff/logon should reset that condition.  If not, reboot."

eemit, I tried, and didn't work, look, this is the problem, or let me explain...
The method I tried to showed you guys would be the perfect way to get this
to work, but there is something going on on my code that for some reasons
some times the output of the method that joint all the files together make
something that some text in the files are missing some times, thats why I
stoped using that code, but the joint work just perfect.
0
 
eemitCommented:
>I tried, and didn't work...
Please explain what happens! It works well here.
0
 
Samuel-AMCAuthor Commented:
"Please explain what happens! It works well here."
Is me the one who should be asking you what you got!
Why would I be telling you that it did not work for me?
If it worked then I would it be really happy and thank you for it.
0
 
Samuel-AMCAuthor Commented:
re-read your own answer ID: 38821132

"If it is always the same content you can rename one of these files to e.g.
"dummy_empty.txt" and compare two files to determine if they are Identical."

NOTE: It seams that 'FF FE' sequence is Byte order mark by Unicode files.
Byte order mark
FF FE
Description
UTF-16, little endian

copying these files will end in the same situation, the whole point here is to
determine which files are empty and which files have some text content, then
if the file have no text, then that file will be deleted. then as for the one's with
some sort of small data on it, to get arround with this issue I decided to joint all
the files, which I posted the code, and nobody commented anything about it.
0
 
Samuel-AMCAuthor Commented:
Let me do it again with your code and see what I get...
0
 
Samuel-AMCAuthor Commented:
Okay, you know what the problem is? here is the situation, not always I get the
same retunr, sometimes is FF, some other times could be CO or GC, and so on.
now this is the first time I cehcked these files with a hex editor thanks to Martin,
I never had this idea on checking these files with a hex editor, now I see that only
few of these files are coming out with that small data on it, and I also think that there
are only three files, then if thats the case, I could track them down.
0
 
Samuel-AMCAuthor Commented:
Lets assume that these two files are not equal FF.txt and CO.txt, then what? whats next?
oh okay I get it, dummy_empty.txt will be created, am I right? I also forgot to mention
that I had some issues running the code. strNames - sub or function not defined.
0
 
eemitCommented:
Rename the Function AreTheyTheSame to AreFilesTheSame.
Or change AreFilesTheSame to AreTheyTheSame.
0
 
Samuel-AMCAuthor Commented:
It doesn't want to work for me, I still get the same error.
Error point to this line: strNames - Error: sub or function not defined.
I changed the name.
0
 
eemitCommented:
You should combine all with the code from ID: 38818225
Here is all:

  Dim intNum As Integer
  Dim strNames()
  strNames = Array("BS", "CO", "FF", "GC", "IE", "MN", "NS", "NT", "OA", "RR", "SS", "WP")
 
  For intNum = 0 To 11
   
      If FileExists("C:\" & strNames(intNum) & ".txt") Then
          ' FileLen returns file size in bytes
          If FileLen("C:\" & strNames(intNum) & ".txt") = 0 Then
              Kill "C:\" & strNames(intNum) & ".txt"
          ElseIf AreFilesTheSame("C:\" & strNames(intNum) & ".txt", "C:\" & "dummy_empty.txt", True) Then
              Kill "C:\" & strNames(intNum) & ".txt"
          End If
      End If

  Next

End Sub

Private Function FileExists(ByVal fname As String) As Boolean
  On Error Resume Next
  FileExists = (GetAttr(fname) And vbDirectory) = vbNormal
End Function
0
 
Samuel-AMCAuthor Commented:
eemit, thanks for the code, but I thought that you was suggesting me the code
where the dummy file is created to avoid using my code to joint all the files.
ID: 38821132

If i use my code to joint all the files, then there is no reason for me to use the code
you suggested. now I get the point, if thats the case I won't get anywhere with that.
0
 
eemitCommented:
OK, try this:

Private Sub Command1_Click()
  On Error GoTo Err_Handler
  
  Dim FSO As New FileSystemObject
  Dim sFilePath As String
  Dim sSeparator As String
  
  sFilePath = "C:\"  'change this to your File Path
  sSeparator = vbNewLine & "#FilePath#" & vbNewLine
  
  ConcatenateFiles sFilePath, "MySystem.dat", sSeparator, "WP.txt", "BS.txt", "CO.txt", "FF.txt", "GC.txt", "IE.txt", "MN.txt", "NS.txt", "NT.txt", "OA.txt", "RR.txt", "SS.txt"
  
  DeleteMyFiles sFilePath, "WP.txt", "BS.txt", "CO.txt", "FF.txt", "GC.txt", "IE.txt", "MN.txt", "NS.txt", "NT.txt", "OA.txt", "RR.txt", "SS.txt"
  
  'End
  
  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (Command1_Click): " & Err.Description & ", " & CStr(Err.Number)

End Sub


Private Sub ConcatenateFiles( _
                    ByVal sFilePath As String, _
                    ByVal ResultFile As String, _
                    ByVal Separator As String, _
                    ParamArray SourceFiles() As Variant _
                    )
                    
  On Error GoTo Err_Handler
  
  Dim FSO As New FileSystemObject
  Dim fsSourceStream As TextStream
  Dim fsResStream As TextStream
  Dim sSeparator As String
  Dim i As Integer
  
  Set fsResStream = FSO.OpenTextFile(sFilePath & ResultFile, ForWriting, True)
  For i = 0 To UBound(SourceFiles)
      sSeparator = Replace(Separator, "#FilePath#", SourceFiles(i))
      
      fsResStream.Write sSeparator & vbCrLf
      
      If FSO.FileExists(sFilePath & SourceFiles(i)) Then
          Set fsSourceStream = FSO.OpenTextFile(sFilePath & SourceFiles(i), ForReading)
          If fsSourceStream.AtEndOfStream Then
              fsResStream.Write "File is empty" & vbCrLf
          Else
              fsResStream.Write fsSourceStream.ReadAll & vbCrLf
              fsSourceStream.Close
          End If
      Else
          fsResStream.Write "File not found" & vbCrLf
      End If
  Next i
  fsResStream.Close
  
  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (ConcatenateFiles): " & Err.Description & ", " & CStr(Err.Number)
  Resume Next
  
End Sub

Private Sub DeleteMyFiles( _
                    ByVal sFilePath As String, _
                    ParamArray SourceFiles() As Variant _
                    )
  On Error GoTo Err_Handler
  
  Dim FSO As New FileSystemObject
  Dim i As Integer
  
  For i = 0 To UBound(SourceFiles)
      If FSO.FileExists(sFilePath & SourceFiles(i)) Then
          FSO.DeleteFile sFilePath & SourceFiles(i)
      End If
  Next i

  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (DeleteMyFiles): " & Err.Description & ", " & CStr(Err.Number)

End Sub

Open in new window

0
 
Samuel-AMCAuthor Commented:
Compile error: User-defined type not defined

It point to this line
Dim FSO As New FileSystemObject
0
 
aikimarkCommented:
you can add a scripting runtime reference

or

change
  Dim FSO As New FileSystemObject

to
  Dim FSO As Object

And add
Set FSO = CreateObject("Scripting.FileSystemObject")
0
 
Samuel-AMCAuthor Commented:
Now I get the same error: Compile error: User-defined type not defined
Pointing to this line: Dim fsSourceStream As TextStream
0
 
eemitCommented:
I thought that you have already added reference to scripting runtime.
(You said:  "...but the joint work just perfect")

Set Project References to:
      Microsoft Scripting Runtime
on Windows XP (32 bit):
      C:Windows\system32\scrrun.dll"
on Windows 7 (64-bit):      
      C:Windows\SysWOW64\scrrun.dll

Change now the line:
          Set fsSourceStream = FSO.OpenTextFile(sFilePath & SourceFiles(i), ForReading)
To:
          Set fsSourceStream = FSO.OpenTextFile(sFilePath & SourceFiles(i), ForReading, False, TristateMixed)
Or to:
          Set fsSourceStream = FSO.OpenTextFile(sFilePath & SourceFiles(i), ForReading, False, TristateUseDefault)
to see the result:
(Instead of "ÿþ" for the file with "FF FE" sequence you should get "File is empty")
0
 
Samuel-AMCAuthor Commented:
All the files get deleted
0
 
eemitCommented:
Is this good or bad?
You have this in your ID: 38826264
0
 
aikimarkCommented:
change to
Dim fsSourceStream As Object
0
 
eemitCommented:
OK Try this:

Set Project References to:
      Microsoft Scripting Runtime
on Windows XP (32 bit):
      C:Windows\system32\scrrun.dll"
on Windows 7 (64-bit):      
      C:Windows\SysWOW64\scrrun.dll


Private Sub ConcatenateFiles( _
                    ByVal sFilePath As String, _
                    ByVal ResultFile As String, _
                    ByVal Separator As String, _
                    ParamArray SourceFiles() As Variant _
                    )
                    
  On Error GoTo Err_Handler
  
  Dim FSO As FileSystemObject
  Set FSO = New FileSystemObject
  
  Dim fsSourceStream As TextStream
  Dim fsResStream As TextStream
  Dim sSeparator As String
  Dim i As Integer
  
  Set fsResStream = FSO.OpenTextFile(sFilePath & ResultFile, ForWriting, True)
  For i = 0 To UBound(SourceFiles)
      sSeparator = Replace(Separator, "#FilePath#", SourceFiles(i))
      
      fsResStream.Write sSeparator & vbCrLf
      
      If FSO.FileExists(sFilePath & SourceFiles(i)) Then
          Set fsSourceStream = FSO.OpenTextFile(sFilePath & SourceFiles(i), ForReading, False, TristateUseDefault)

          If fsSourceStream.AtEndOfStream Then
              fsResStream.Write "File is empty" & vbCrLf

              fsSourceStream.Close
              'Set fsSourceStream = Nothing
              FSO.DeleteFile sFilePath & SourceFiles(i)
          Else
              fsResStream.Write fsSourceStream.ReadAll & vbCrLf
              fsSourceStream.Close
          End If
      Else
          fsResStream.Write "File not found" & vbCrLf
      End If
  Next i
  fsResStream.Close
  
  Set fsSourceStream = Nothing
  Set fsResStream  = Nothing
  Set FSO = Nothing
  
Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (ConcatenateFiles): " & Err.Description & ", " & CStr(Err.Number)
  Resume Next
  
End Sub

Private Sub Command1_Click()
  On Error GoTo Err_Handler
  
  Dim sFilePath As String
  Dim sSeparator As String
  
  sFilePath = "C:\"  'change to your File Path
  sSeparator = vbNewLine & "#FilePath#" & vbNewLine
  
  ConcatenateFiles sFilePath, "MySystem.dat", sSeparator, "WP.txt", "BS.txt", "CO.txt", "FF.txt", "GC.txt", "IE.txt", "MN.txt", "NS.txt", "NT.txt", "OA.txt", "RR.txt", "SS.txt"
  
  'End
  
  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (Command1_Click): " & Err.Description & ", " & CStr(Err.Number)

End Sub

Open in new window

0
 
Samuel-AMCAuthor Commented:
Hey eemit, I'm sorry I underestimated you...
You the best man, thanks for not giving up on me,
This time the code really rock!!! ...it works man! WooHoo!!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.