Help with FileSystemObject and text files (1 Viewer)

P

P Zero

Registered User.
Local time
Today, 00:57
Joined
Mar 15, 2006
Messages
41
I asked about a more basic version of this problem a previous post, but now I need some more in depth information, in particular about the FileSystemObject. First, let me describe what I need to do;

I need to output data from a form to a text file. The text file contains information, including title and revision, about the final document that my database creates. A seperate database system not written by me reads the text file to find out the information it needs to create issue sheets and issue history. My final document may be issued 5 or 6 times, maybe more. Each time it is issued it needs to reflect its new revision in the text file, adding a new line to the end. So on the first issue of the document, the text file would look like this;

Code: 
RDS~EDINBURGH SCHOOL~ROOM DATASHEETS~A4~~INFORMATION~
*~C. DRAKE~10/04/2006~F. LEONARD~10/04/2006~~~


Then the second revision might look like this;

Code: 
RDS~EDINBURGH SCHOOL~ROOM DATASHEETS~A4~~INFORMATION~
*~C. DRAKE~10/04/2006~F. LEONARD~10/04/2006~~~
1~A. MELICHAR~11/04/2006~C. DRURY~11/04/2006~~~


But the the third may look like this, notice the status change;

Code: 
RDS~EDINBURGH SCHOOL~ROOM DATASHEETS~A4~~CONSTRUCTION~
*~C. DRAKE~10/04/2006~F. LEONARD~10/04/2006~~~
1~A. MELICHAR~11/04/2006~C. DRURY~11/04/2006~~~
2~C. DRAKE~14/04/2006~C. DRURY~14/04/2006~~~


My code so far is as follows;

To create and write the first two lines in the text file for the first issue;

Code: 
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.CreateTextFile("D:\RDS Base\RDS.rev", True)
txt.WriteLine ("RDS~PROJECT NAME~ROOM DATASHEETS~A4~~" & Status & "~")
txt.WriteLine (Revision & "~" & ModifiedName & "~" & ModifiedDate & "~" & AuthorisedName & "~" & AuthorisedDate & "~~~")
txt.Close

To add a line to the end of the text file for subsequent revisions;

Code: 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.OpenTextFile("D:\RDS Base\RDS.rev", ForAppending, False)
txt.WriteLine (Revision & "~" & ModifiedName & "~" & ModifiedDate & "~" & AuthorisedName & "~" & AuthorisedDate & "~~~")
txt.Close


My problem is as follows - I can create the text file and add lines to it using information from my database, but how do I change the status, which is always on the first line of the text file? My table holding the revisions contains a status field, so the user must specify the status for each revision. That means that the first line of the text file must be modified every revision to reflect the status in the new revision, as well as adding the new line to the end to show the revision information. I have searched the web and this forum, but to no avail.

I hope this is clear. I really need some help on this so if it needs clearing up, let me know.
 
Last edited:
MarkK

MarkK

bit cruncher
Local time
Yesterday, 16:57
Joined
Mar 17, 2004
Messages
8,181
Don't worry about preserving the existing file.
1) Read in the whole file and assign all it's text to a local string variable
2) Edit the text as required by splitting it into a variant array at the tildes
3) Join it back into a single delimited string
4) Add a new line to you string
5) Write the whole string back to file of the same name, overwriting the original

You can also set a reference to the "Microsoft Scripting Runtime" and get intellisense on all its objects
Code: 
Sub alksjdhf()
   Dim fso As New Scripting.FileSystemObject
   Dim ts As Scripting.TextStream
   Dim s As String
   Dim v As Variant
   
[COLOR="Green"]   'get existing data[/COLOR]
   Set ts = fso.OpenTextFile("C:\testfile.txt")
   s = ts.ReadAll
   ts.Close
[COLOR="Green"]   'modify existing data[/COLOR]
   v = VBA.Strings.Split(s, "~")
   v(5) = "Construction"
   s = VBA.Strings.Join(v, "~")
[COLOR="Green"]   'append new line[/COLOR]
   s = s & Revision & "~" & ModifiedName & "~" & ModifiedDate & "~" & AuthorisedName & "~" & AuthorisedDate & "~~~"
[COLOR="Green"]   'and rewrite the whole file[/COLOR]
   Set ts = fso.OpenTextFile("C:\testfile.txt", ForWriting)
   ts.Write s
   ts.Close

End Sub
 
P

P Zero

Registered User.
Local time
Today, 00:57
Joined
Mar 15, 2006
Messages
41
Thanks very much, lagbolt. That worked great! I had to make a couple of small modifications to get it to format the text properly, but apart from that, fantastic :D
 
P

P Zero

Registered User.
Local time
Today, 00:57
Joined
Mar 15, 2006
Messages
41
I need to make some changes to the functionality of this button now. It will be basically the same, but let me redefine the problem. Here is the DEFINITIVE code I am using now;

Code: 
Private Sub BTNAddRev_Click()

   Dim fso As New Scripting.FileSystemObject
   Dim ts As Scripting.TextStream
   Dim s As String
   Dim v As Variant
   
   'get existing data
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev")
   s = ts.ReadAll
   ts.Close
   'modify existing data
   v = VBA.Strings.Split(s, "~")
   v(5) = Status
   s = VBA.Strings.Join(v, "~")
   'append new line
   s = s
   'and rewrite the whole file
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev", ForWriting)
   ts.Write s
   ts.WriteLine
   ts.Write (Revision & "~" & RevisedBy & "~" & RevisedDate & "~" & AuthorisedBy & "~" & AuthorisedDate & "~~~")
   ts.Close
   
   Forms![Revisions].Requery
   
   DoCmd.Close

End Sub

Instead of having a seperate function to create the initial text file, how would I modify this code to do the following?;

Check to see if the file "D:\RDS Base\RDS.rev" exists.
If it does, go to the above code.
If not, create it with the line "RDS~~ROOM DATASHEETS~A4~~~"
Then go to the above code.


I appreciate any help. I'm not that great with VB.
 
MarkK

MarkK

bit cruncher
Local time
Yesterday, 16:57
Joined
Mar 17, 2004
Messages
8,181
I believe the OpenTextFile method of the FileSystemObject creates the file if it doesn't already exist. If this is so, then add the line of code in red...
Code: 
Private Sub BTNAddRev_Click()

   Dim fso As New Scripting.FileSystemObject
   Dim ts As Scripting.TextStream
   Dim s As String
   Dim v As Variant
   
   'get existing data
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev")
   s = ts.ReadAll
[COLOR="DarkRed"]   if s = "" then s = "RDS~~ROOM DATASHEETS~A4~~~"[/COLOR]
   ts.Close
   'modify existing data
   v = VBA.Strings.Split(s, "~")
   v(5) = Status
   s = VBA.Strings.Join(v, "~")
   'append new line
   s = s
   'and rewrite the whole file
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev", ForWriting)
   ts.Write s
   ts.WriteLine
   ts.Write (Revision & "~" & RevisedBy & "~" & RevisedDate & "~" & AuthorisedBy & "~" & AuthorisedDate & "~~~")
   ts.Close
   
   Forms![Revisions].Requery
   
   DoCmd.Close

End Sub
 
P

P Zero

Registered User.
Local time
Today, 00:57
Joined
Mar 15, 2006
Messages
41
It doesnt seem to like that. What if I changed it to CreateTextFile?
 
MarkK

MarkK

bit cruncher
Local time
Yesterday, 16:57
Joined
Mar 17, 2004
Messages
8,181
Modify this line,
Code: 
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev")
As follows,
Code: 
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev", , True)
Which causes the OpenTextFile method to create the file if not found. See if that does it.
Mark
 
P

P Zero

Registered User.
Local time
Today, 00:57
Joined
Mar 15, 2006
Messages
41
That now creates the file, but brings up a "Run-time error '62': Input past end of file" on the line "s = ts.ReadAll".
 
MarkK

MarkK

bit cruncher
Local time
Yesterday, 16:57
Joined
Mar 17, 2004
Messages
8,181
Try...
Code: 
  [COLOR="Green"] 'open or create the file, as the case may be[/COLOR]
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev", , True)
[COLOR="Green"]   'check for EndOfStream[/COLOR]
   If Not ts.AtEndOfStream Then
[COLOR="Green"]      'there is data in the file, so read it[/COLOR]
      s = ts.ReadAll
   Else
[COLOR="Green"]      'no data in the file, so create some...[/COLOR]
      s = "RDS~~ROOM DATASHEETS~A4~~~"
   End If
[COLOR="Green"]   'and close the stream[/COLOR]
   ts.Close
Cheers,
 
P

P Zero

Registered User.
Local time
Today, 00:57
Joined
Mar 15, 2006
Messages
41
Spot on chap. That now works perfectly. I jst wish I had your knowledge of VB. It would make this project a whole lot easier.

Thanks again. Its great to be able to have access to your sort of skills!
 
M

mjseim

Registered User.
Local time
Yesterday, 16:57
Joined
Sep 21, 2005
Messages
62
I'm trying to make the code posted work for my database. I do not want to zip the database (unless someone knows how to use the native Windows zipping tool as I do not have nor do I want WinZip).

I can't seem to get this code to work. Everytime I run it I get a message saying:

"Compile Error: User-defined type not defined"
With highlighted code "fso As FileSystemObject"

Any help would be appreciated.



Code: 
Dim fso As FileSystemObject

Dim sPath As String
Dim sSourceFile As String
Dim sBackupFile As String

sPath = CurrentProject.Path
sSourceFile = "Daves Database.mdb"
sBackupFile = "Master Budgeting and Estimating Database" & Format(Date, "yyyy-mm-dd") & "_" & Format(Time, "hhmmss") & ".mdb"

Set fso = New FileSystemObject
fso.CopyFile sPath & sSourceFile, sPath & sBackupFile, True
Set fso = Nothing

Beep
MsgBox "Backup was successful and saved @ " & Chr(13) & Chr(13) & sPath & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13), vbInformation, "Backup Completed"

If Dir(sPath & sBackupFile) <> "" Then Kill (sPath & sBackupFile)
 
KeithG

KeithG

AWF VIP
Local time
Yesterday, 16:57
Joined
Mar 23, 2006
Messages
2,592
You need to set a reference to the Microsoft Scripting Runtime
 
M

mjseim

Registered User.
Local time
Yesterday, 16:57
Joined
Sep 21, 2005
Messages
62
Considering I don't know what that's talking about...

How do I set a reference to the Microsoft Scripting Runtime??? :)
 
boblarson

boblarson

Smeghead
Local time
Yesterday, 16:57
Joined
Jan 12, 2001
Messages
32,059
From the VBA window:


 
M

mjseim

Registered User.
Local time
Yesterday, 16:57
Joined
Sep 21, 2005
Messages
62
MOST EXCELLENT!!! Thank you. It worked like a charm.

In case anyone wants the backup code without the WinZip function, here is my stab at it.


Code: 
Dim fso As FileSystemObject

Dim sSourcePath As String
Dim sBackupPath As String
Dim sSourceFile As String
Dim sBackupFile As String

sSourcePath = CurrentProject.Path & "\"
sBackupPath = CurrentProject.Path & "\- Database Backups\"
sSourceFile = CurrentProject.Name
sBackupFile = "Master Budgeting and Estimating Database - BACKUP " & Format(Date, "yyyy-mm-dd") & ".mdb"

Set fso = New FileSystemObject
fso.CopyFile sSourcePath & sSourceFile, sBackupPath & sBackupFile, True
Set fso = Nothing

Beep
MsgBox "Original File: " & vbNewLine & sSourcePath & sSourceFile & vbNewLine & vbNewLine & _
    "Backup File: " & vbNewLine & sBackupPath & sBackupFile, vbInformation, "Backup Completed"
 
J

Jonny

Registered User.
Local time
Today, 02:57
Joined
Aug 12, 2005
Messages
144
Where to put that code?
Where located the event that fires on exit?
 
You must log in or register to reply here.

Similar threads

A
Inventory Model Brainstorming
Replies
3
Views
328
adhoustonj
A
A
CSV File Created, Phone Number Displayed with Special Char and Letters
2
Replies
33
Views
2,611
Pat Hartman
P
Cotswold
Solved Read Text File Into Table Issue
2
Replies
38
Views
3,498
gemma-the-husky
gemma-the-husky
O
Weird Issue - Printing reports with missing text
Replies
2
Views
424
ongbl
O
S
Excel VBA - "[Microsoft][ODBC Text Driver] Record is too Large." - Joining 2 csv file
Replies
1
Views
1,456
Uncle Gizmo
Uncle Gizmo

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom