Solved

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

Posted on 2013-01-24
81
578 Views
Last Modified: 2013-01-31
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.
0
Comment
Question by:Samuel-AMC
  • 45
  • 22
  • 11
  • +1
81 Comments
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817156
Open "C:\temp\empty.txt" For Input As #1

If EOF(1) Then
    MsgBox "Empty"
    Kill "C:\temp\empty.txt"
End If
0
 

Author Comment

by:Samuel-AMC
ID: 38817172
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817174
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
 

Author Comment

by:Samuel-AMC
ID: 38817196
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817205
That's what my code in post ID: 38817156 does.
0
 

Author Comment

by:Samuel-AMC
ID: 38817238
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817249
All you need is the path to the file.
0
 

Author Comment

by:Samuel-AMC
ID: 38817252
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817266
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
 

Author Comment

by:Samuel-AMC
ID: 38817298
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
 

Author Comment

by:Samuel-AMC
ID: 38817301
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
 

Author Comment

by:Samuel-AMC
ID: 38817317
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817373
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817395
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
 

Author Comment

by:Samuel-AMC
ID: 38817399
Thanks Martin, the names are like:
SS.txt, NT.txt, OC.txt, WP.txt, and so on.
0
 

Author Comment

by:Samuel-AMC
ID: 38817402
This is my total file in their order:
BS, CO, FF, GC, IE, MN, NS, NT, OA, RR, SS, WP.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817424
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
 

Author Comment

by:Samuel-AMC
ID: 38817431
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817462
Do you still have On Error Resume Next in your code? If so remove it and tell me what happens.
0
 

Author Comment

by:Samuel-AMC
ID: 38817482
I added, but thats not the problem, the issue is that now none of the files get deleted.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817497
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
 

Author Comment

by:Samuel-AMC
ID: 38817527
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817536
What EXACTLY is the error that you get when you remove the On Error Resume Next line?
0
 

Author Comment

by:Samuel-AMC
ID: 38817558
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817571
Please show the code you are using (even if it's mine).
0
 

Author Comment

by:Samuel-AMC
ID: 38817578
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
 

Author Comment

by:Samuel-AMC
ID: 38817592
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
 
LVL 45

Assisted Solution

by:Martin Liss
Martin Liss earned 100 total points
ID: 38817604
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
 

Author Comment

by:Samuel-AMC
ID: 38817613
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
 

Author Comment

by:Samuel-AMC
ID: 38817628
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38817647
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
 

Author Comment

by:Samuel-AMC
ID: 38817655
Okay thanks Martin, I will do that when you get back tomorrow.
Thank you
0
 

Author Comment

by:Samuel-AMC
ID: 38817668
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
 
LVL 15

Expert Comment

by:eemit
ID: 38818225
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
 

Author Comment

by:Samuel-AMC
ID: 38818263
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38818384
Please attach one of the files that has the the very small portion of data.
0
 

Author Comment

by:Samuel-AMC
ID: 38819336
Thanks Martin, with the hex editor this is what I see on this text file: ÿþ
FF.txt
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38819510
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
 

Author Comment

by:Samuel-AMC
ID: 38819555
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38819568
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
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:Samuel-AMC
ID: 38819574
Hold on Martin, this will be the same thing to you :-D let me Zipped for you
instead of rar, sorry
0
 

Author Comment

by:Samuel-AMC
ID: 38819585
Okay, here is a Zip file
FF.zip
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38819624
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
 

Author Comment

by:Samuel-AMC
ID: 38819659
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
 

Author Comment

by:Samuel-AMC
ID: 38819672
Martin, thank you for your help, I will be back to this question later,
I have to go now, thank you so much.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38819679
Please attach the 3 files (in one zip is good) that you have a problem with.
0
 

Author Comment

by:Samuel-AMC
ID: 38820828
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
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38820945
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
 

Author Comment

by:Samuel-AMC
ID: 38820954
Martin, still the same as the code before, this code delete 9 files from the 12.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38820985
Do it twice and see what happens.
0
 

Author Comment

by:Samuel-AMC
ID: 38821040
Martin, it does it at once, I mean, it kills all the 9 files from the 12.
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 38821062
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
 

Author Comment

by:Samuel-AMC
ID: 38821121
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
 

Author Comment

by:Samuel-AMC
ID: 38821130
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
 
LVL 15

Expert Comment

by:eemit
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.

          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
 

Author Comment

by:Samuel-AMC
ID: 38826264
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
 

Author Comment

by:Samuel-AMC
ID: 38826270
Let me know what you guys think about this other method, thanks.
0
 
LVL 15

Expert Comment

by:eemit
ID: 38826549
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
 
LVL 45

Expert Comment

by:aikimark
ID: 38826604
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
 

Author Comment

by:Samuel-AMC
ID: 38834950
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
 
LVL 15

Expert Comment

by:eemit
ID: 38835441
>I tried, and didn't work...
Please explain what happens! It works well here.
0
 

Author Comment

by:Samuel-AMC
ID: 38835652
"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
 

Author Comment

by:Samuel-AMC
ID: 38835694
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
 

Author Comment

by:Samuel-AMC
ID: 38835718
Let me do it again with your code and see what I get...
0
 

Author Comment

by:Samuel-AMC
ID: 38835735
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
 

Author Comment

by:Samuel-AMC
ID: 38835767
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
 
LVL 15

Expert Comment

by:eemit
ID: 38835966
Rename the Function AreTheyTheSame to AreFilesTheSame.
Or change AreFilesTheSame to AreTheyTheSame.
0
 

Author Comment

by:Samuel-AMC
ID: 38838929
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
 
LVL 15

Expert Comment

by:eemit
ID: 38839846
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
 

Author Comment

by:Samuel-AMC
ID: 38840086
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
 
LVL 15

Expert Comment

by:eemit
ID: 38840816
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
 

Author Comment

by:Samuel-AMC
ID: 38840854
Compile error: User-defined type not defined

It point to this line
Dim FSO As New FileSystemObject
0
 
LVL 45

Expert Comment

by:aikimark
ID: 38840877
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
 

Author Comment

by:Samuel-AMC
ID: 38840961
Now I get the same error: Compile error: User-defined type not defined
Pointing to this line: Dim fsSourceStream As TextStream
0
 
LVL 15

Expert Comment

by:eemit
ID: 38840973
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
 

Author Comment

by:Samuel-AMC
ID: 38841094
All the files get deleted
0
 
LVL 15

Expert Comment

by:eemit
ID: 38841225
Is this good or bad?
You have this in your ID: 38826264
0
 
LVL 45

Expert Comment

by:aikimark
ID: 38841285
change to
Dim fsSourceStream As Object
0
 
LVL 15

Expert Comment

by:eemit
ID: 38841496
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
 
LVL 15

Accepted Solution

by:
eemit earned 400 total points
ID: 38841861
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
 

Author Comment

by:Samuel-AMC
ID: 38842755
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

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now