Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 04-10-2006, 01:27 AM   #1
P Zero
Registered User
 
Join Date: Mar 2006
Posts: 41
Thanks: 0
Thanked 0 Times in 0 Posts
P Zero is an unknown quantity at this point
Help with FileSystemObject and text files

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 by P Zero; 04-10-2006 at 01:30 AM.
P Zero is offline   Reply With Quote
Old 04-10-2006, 01:04 PM   #2
MarkK
Super Moderator
 
MarkK's Avatar
 
Join Date: Mar 2004
Location: Vancouver BC
Posts: 7,761
Thanks: 10
Thanked 1,290 Times in 1,227 Posts
MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all
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
   
   'get existing data
   Set ts = fso.OpenTextFile("C:\testfile.txt")
   s = ts.ReadAll
   ts.Close
   'modify existing data
   v = VBA.Strings.Split(s, "~")
   v(5) = "Construction"
   s = VBA.Strings.Join(v, "~")
   'append new line
   s = s & Revision & "~" & ModifiedName & "~" & ModifiedDate & "~" & AuthorisedName & "~" & AuthorisedDate & "~~~"
   'and rewrite the whole file
   Set ts = fso.OpenTextFile("C:\testfile.txt", ForWriting)
   ts.Write s
   ts.Close

End Sub
MarkK is offline   Reply With Quote
Old 04-11-2006, 01:29 AM   #3
P Zero
Registered User
 
Join Date: Mar 2006
Posts: 41
Thanks: 0
Thanked 0 Times in 0 Posts
P Zero is an unknown quantity at this point
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

P Zero is offline   Reply With Quote
Old 04-11-2006, 02:12 AM   #4
P Zero
Registered User
 
Join Date: Mar 2006
Posts: 41
Thanks: 0
Thanked 0 Times in 0 Posts
P Zero is an unknown quantity at this point
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.
P Zero is offline   Reply With Quote
Old 04-11-2006, 02:46 AM   #5
MarkK
Super Moderator
 
MarkK's Avatar
 
Join Date: Mar 2004
Location: Vancouver BC
Posts: 7,761
Thanks: 10
Thanked 1,290 Times in 1,227 Posts
MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all
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
   if s = "" then s = "RDS~~ROOM DATASHEETS~A4~~~"
   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
MarkK is offline   Reply With Quote
Old 04-11-2006, 02:50 AM   #6
P Zero
Registered User
 
Join Date: Mar 2006
Posts: 41
Thanks: 0
Thanked 0 Times in 0 Posts
P Zero is an unknown quantity at this point
It doesnt seem to like that. What if I changed it to CreateTextFile?
P Zero is offline   Reply With Quote
Old 04-11-2006, 03:04 AM   #7
MarkK
Super Moderator
 
MarkK's Avatar
 
Join Date: Mar 2004
Location: Vancouver BC
Posts: 7,761
Thanks: 10
Thanked 1,290 Times in 1,227 Posts
MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all
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

MarkK is offline   Reply With Quote
Old 04-11-2006, 03:10 AM   #8
P Zero
Registered User
 
Join Date: Mar 2006
Posts: 41
Thanks: 0
Thanked 0 Times in 0 Posts
P Zero is an unknown quantity at this point
That now creates the file, but brings up a "Run-time error '62': Input past end of file" on the line "s = ts.ReadAll".
P Zero is offline   Reply With Quote
Old 04-11-2006, 03:24 AM   #9
MarkK
Super Moderator
 
MarkK's Avatar
 
Join Date: Mar 2004
Location: Vancouver BC
Posts: 7,761
Thanks: 10
Thanked 1,290 Times in 1,227 Posts
MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all MarkK is a name known to all
Try...
Code:
   'open or create the file, as the case may be
   Set ts = fso.OpenTextFile("D:\RDS Base\RDS.rev", , True)
   'check for EndOfStream
   If Not ts.AtEndOfStream Then
      'there is data in the file, so read it
      s = ts.ReadAll
   Else
      'no data in the file, so create some...
      s = "RDS~~ROOM DATASHEETS~A4~~~"
   End If
   'and close the stream
   ts.Close
Cheers,
MarkK is offline   Reply With Quote
Old 04-11-2006, 03:32 AM   #10
P Zero
Registered User
 
Join Date: Mar 2006
Posts: 41
Thanks: 0
Thanked 0 Times in 0 Posts
P Zero is an unknown quantity at this point
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!
P Zero is offline   Reply With Quote
Old 02-08-2007, 07:48 AM   #11
mjseim
Newly Registered User
 
Join Date: Sep 2005
Posts: 62
Thanks: 1
Thanked 2 Times in 2 Posts
mjseim is on a distinguished road
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)
mjseim is offline   Reply With Quote
Old 02-08-2007, 07:54 AM   #12
KeithG
AWF VIP
 
KeithG's Avatar
 
Join Date: Mar 2006
Location: Illinois
Posts: 2,592
Thanks: 0
Thanked 4 Times in 4 Posts
KeithG will become famous soon enough KeithG will become famous soon enough
You need to set a reference to the Microsoft Scripting Runtime
KeithG is offline   Reply With Quote
Old 02-08-2007, 08:15 AM   #13
mjseim
Newly Registered User
 
Join Date: Sep 2005
Posts: 62
Thanks: 1
Thanked 2 Times in 2 Posts
mjseim is on a distinguished road
Considering I don't know what that's talking about...

How do I set a reference to the Microsoft Scripting Runtime???
mjseim is offline   Reply With Quote
Old 02-08-2007, 08:27 AM   #14
boblarson
Smeghead
 
boblarson's Avatar
 
Join Date: Jan 2001
Location: Oregon, USA
Posts: 32,068
Thanks: 97
Thanked 1,828 Times in 1,579 Posts
boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold boblarson is a splendid one to behold
From the VBA window:


__________________

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
boblarson is offline   Reply With Quote
Old 02-08-2007, 09:33 AM   #15
mjseim
Newly Registered User
 
Join Date: Sep 2005
Posts: 62
Thanks: 1
Thanked 2 Times in 2 Posts
mjseim is on a distinguished road
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"

mjseim is offline   Reply With Quote
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump




All times are GMT -8. The time now is 06:04 PM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World