Question Export Rows into individual text files?

[jas_ridge]

I am not new to Access, but mainly only use it for queries. If I have posted this question in the wrong forum please direct me to the appropriate one.

I have a table that has over 6000 rows with two columns. One a title and the other a memo column with transcripts from interviews (some being extremely long). I do research using content analysis and to do that on these interviews, I need each one saved in its own text file.

Specifically I need to export each transcript into its own text file and save that file using the title from the other column. So I would end up with over 6000 text files all being saved using the title from the corresponding row as the transcript.

Is this even possible?

Thank you for any help that you could provide even if it is telling me I am asking too much of the program.

 

[WayneRyan]

Jas,

Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Select * From YourTable")
While Not rst.EOF And Not rst.BOF
   Close #1
   Open "C:\SomeDir\" & RTrim(rst!Title) & ".txt" For Output As #1
   Print #1, RTrim(rst!Transcript)
   Close #1
   rst.MoveNext
   Wend

hth,
Wayne

 

[Pat Hartman]

You'll need a DAO code loop to open a recordset, read each record, and write a file.
Air code to get you started:

Dim db as DAO.Database
Dim td as DAO.Tabledef
Dim rs as DAO.Recordset
Dim strPath as String
    Set db = Currentdb()
    Set td = db.Tabledefs("yourtablename")
    Set rs = td.Openrecordset
    strPath = "C:\yourpath\"
    Do Until rs.Eof = True
        Me.txtKeyFld = rs!PrimaryKeyField
        docmd.OutputTo acOutputReport,"name",acformatRTF, """" &strPath & rs!OtherField & """"
        rs.MoveNext
    Loop

OutputTo doesn't give you a filter or Where argument as OpenReport does so you need another method of telling the report what record to print. The easiest method is to use a RecordSource query that references a form field so the code loop replaces the value in the form field for each file it prints. In my example, I hard-coded the path. You can have the user enter it in a form field also.

 

[jas_ridge]

Thank you both for your responses. However, I am going to show my ignorance in that I have been unable to get either of the codes to work.

Am I correct in just changing the various aspects of the code to match my table and then entering it into visual basic section for a new report?

Sorry for being such a newby, but as I said I use Access almost exclusively for Queries.

Thanks again for your help.

 

[Pat Hartman]

The code would normally be placed in the click event of a button and you will have to replace the query and column and report names with your own.

To add an event procedure, press the builder button to the right of the whitespace. It will either build the header and footer and place the insertion point inside the procedure or it will prompt you. Choose the code option and type your code where the cursor is.

 

[RCesto]

I found this thread when looking to do something similar to the original poster, but I am having trouble running the script that WayneRyan posted. It seems that I am getting 2 specific problems that should be fairly simple to figure out but I have not been able to. The first is that in my specific application I have more then 2 columns in a row I would like exported into a text file, it is more like 90+, and it seems that the script fails after a certain number of rows are inserted into the script. Is there a select all rows command or after a certain point is their a break that needs to be inserted?

The 2nd problem is that I have about 198k rows I need exported to text files, but after about 32k I get an unknown path error. I don't know if this is Windows or Access exploding but is there a way to get the script to stop uploading to a folder at a certain number of rows and start exporting to another file? This is the less important of the 2 problems since I can just batch the rows into smaller groups in order to get the text files I need seeing that I will probably have to do that after the script runs anyways. Thank you for your time. I will post the script I have been trying to get run if it is needed but it is more or less WayneRyan's with the variables filled in.

 

[Pat Hartman]

I'm not sure I understand the first problem but rather than using Open/Print, you could try using TransferText. That method will allow you to create an export spec that defines how the fields are formatted. You just have to do the export once manually and save the spec. You can then reference it in the TransferText Method.

The second problem is caused by DOS. There is a limit to the number of files in a directory and that is what you are running into. Is there any part of the data that you could use to separate the output into different folders? If not, you can just add a counter to the loop and every 20,000 rows, change the folder name.

PS - that's a lot of files to create!!!!

 

[RCesto]

Thanks for your help Pat. I'm struggling getting the counter to work within the loop. From what i've been able to gather it should be a

For counter = start To end Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Select * From YourTable")
While Not rst.EOF And Not rst.BOF
   Close #1
   Open "C:\SomeDir\" & RTrim(rst!Title) & ".txt" For Output As #1
   Print #1, RTrim(rst!Transcript)
   Close #1
   rst.MoveNext
Next [1000]
 Open "C:\SomeDir2\" & RTrim(rst!Title) & ".txt" For Output As #1
   Print #1, RTrim(rst!Transcript)
   Close #1
   Wend

Correct? Sorry, i'm sure this is basic for everyone on here but I'm new to using VBA.

 

[RCesto]

Ignore my last post, i've gotten it to run by running

Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Select * From YourTable")
For counter = 1 To 1500
While Not rst.EOF And Not rst.BOF
   Close #1
   Open "C:\SomeDir2\" & RTrim(rst!Title) & ".txt" For Output As #1
   Print #1, RTrim(rst!Transcript)
   Close #1
Next [ Counter ]
For counter = 1501 To 3000
While Not rst.EOF And Not rst.BOF
   Close #1
   Open "C:\SomeDir\" & RTrim(rst!Title) & ".txt" For Output As #1
   Print #1, RTrim(rst!Transcript)
   Close #1
   rst.MoveNext
   Wend

But it is still stopping at the same point in the 2nd Folder (Run Time Error 76). Is this a computer / DOS issue that I am not going to be able to work around? Will I just need to break up my database into bite size portions in order for this to run as through my 200k row database?

 

[Pat Hartman]

Untested but try this:

Dim db as DAO.Database
Dim td as DAO.Tabledef
Dim rs as DAO.Recordset
Dim strPath as String
Dim iRecCount as Integer
Dim iFolderCount as Integer
    Set db = Currentdb()
    Set td = db.Tabledefs("yourtablename")
    Set rs = td.Openrecordset
    iRecCount = 0
    iFolderCount = 1
    strPath = "C:\yourpath" 
    Do Until rs.Eof = True
	strPath = strPath & Format(iFolderCount,"0000")
	iRecCount = iRecCount + 1
        Me.txtKeyFld = rs!PrimaryKeyField
        Close #1
   	Open strPath & "\" & RTrim(rst!Title) & ".txt" For Output As #1
   	Print #1, RTrim(rst!Transcript)
   	Close #1
        rs.MoveNext
	If iRecCount > 20000 Then
	    iRecCount = 0
	    iFolderCount = iFolderCount +1
	End If
    Loop

 

[jdraw]

The error 76 arises if the path is new. The path doesn't exist. You have to create the path before you can use it.

Here is a MakeDir function that you could use or work from

---------------------------------------------------------------------------------------
' Procedure : MakeDir
' DateTime  : 2005-06-28 10:20
' Author    : jdraw
' Purpose   : To make a Directory from within VBA. It checks if
'             the Directory to be created already exists, and gives
'             an Error message if so.
'
'Parameters:
'sDrive  - the Drive on which the new directory is to be built
'sDir    - the new directoryName
'
'Note:   - Only creates 1 level per call
'        - the sDir must have leading \ for each level of directory
' eg  MakeDir "C" ,"\level1"         <--call 1
'     MakeDir "C" ,"\level1\level2"  <--call 2
'     will create c:\level1\level2  <--2 Calls required
'---------------------------------------------------------------------------------------
'
Sub MakeDir(sDrive As String, sDir As String)

On Error GoTo ErrorFound
VBA.FileSystem.MkDir sDrive & ":" & sDir
ErrorFound:
If Err.Number = 75 Then
 MsgBox "Err 75 - Directory (" & sDrive & ":" & sDir & ") already exists"
Else
MsgBox Err.Number & " other error " & Err.Description
End If

End Sub

Good luck


OOOPs: I see Pat has responded while I was typing.

 

[Pat Hartman]

Thanks. I forgot to make the directory first.

 

[RCesto]

Untested but try this:

Dim db as DAO.Database
Dim td as DAO.Tabledef
Dim rs as DAO.Recordset
Dim strPath as String
Dim iRecCount as Integer
Dim iFolderCount as Integer
    Set db = Currentdb()
    Set td = db.Tabledefs("yourtablename")
    Set rs = td.Openrecordset
    iRecCount = 0
    iFolderCount = 1
    strPath = "C:\yourpath" 
    Do Until rs.Eof = True
	strPath = strPath & Format(iFolderCount,"0000")
	iRecCount = iRecCount + 1
        Me.txtKeyFld = rs!PrimaryKeyField
        Close #1
   	Open strPath & "\" & RTrim(rst!Title) & ".txt" For Output As #1
   	Print #1, RTrim(rst!Transcript)
   	Close #1
        rs.MoveNext
	If iRecCount > 20000 Then
	    iRecCount = 0
	    iFolderCount = iFolderCount +1
	End If
    Loop

This seems to be giving me a 424 error on the Open strPath line, it looks like my starPath is set correctly but It is still giving me the error?

 

[Pat Hartman]

Did you add the code that jdaw posted to make the directory first?

 

[RCesto]

I've been trying to get it to work but It isn't accepting the Sub MakeDir to make the directory. - Nevermind I had something dumb that was messing it up.

But it is still giving a 424 error at the OpenstrPath... This is what i'm putting in i'm still confused about what is going on.

Sub MakeDir(sDrive As String, sDir As String)
On Error GoTo ErrorFound
VBA.FileSystem.MkDir sDrive & ":" & sDir
ErrorFound:
If Err.Number = 75 Then
 MsgBox "Err 75 - Directory (" & sDrive & ":" & sDir & ") already exists"
Else
MsgBox Err.Number & " other error " & Err.Description
End If

End Sub

Sub Test()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim rs As DAO.Recordset
Dim strPath As String
Dim iRecCount As Integer
Dim iFolderCount As Integer
MakeDir "C", "\documents\"
MakeDir "C", "\documents\TestFolder\"
Set db = CurrentDb()
    Set td = db.TableDefs("Super_Test_upload")
    Set rs = td.OpenRecordset
    iRecCount = 0
    iFolderCount = 1
    strPath = "C:\Users\myname\Documents\TestFolder5"
Do Until rs.EOF = True
    iRecCount = iRecCount + 1
    strPath = strPath & Format(iFolderCount, "0000")
        txtKeyFld = rs!ProductCode
        Close #1
   Open strPath & "\" & RTrim(rst!ProductCode) & ".txt" For Output As #1
   Print #1, RTrim(rst!TONSTANDTONSOFCOLUMNS).....
 Close #1
   rs.MoveNext
    If iRecCount > 20000 Then
        iRecCount = 0
        iFolderCount = iFolderCount + 1
    End If
    Loop
End Sub

If I fix I find how to get it to run before a reply i'll let everyone know.

Edit: It also say I am using the Me. command incorrectly somehow?

 

[jdraw]

i did just test the MakeDir function and it worked fine. However, it does give a message showing 0 in the message.

It's an older function, and this slight change to the messaging may be more appropriate.

Sub MakeDir(sDrive As String, sDir As String)

On Error GoTo ErrorFound
VBA.FileSystem.MkDir sDrive & ":" & sDir
ErrorFound:
[B][COLOR="Purple"]If Err.Number = 75 Then
 MsgBox "Err 75 - Directory (" & sDrive & ":" & sDir & ") already exists"
ElseIf Err.Number <> 0 Then
 MsgBox Err.Number & " other error " & Err.Description
Else
 MsgBox "Successfully created directory  " & sDir, vbOKOnly
End If[/COLOR][/B]

End Sub

Also where/how are executing your procedure??

 

[RCesto]

I was pulling the 0 error before but I figure it was coming up with that to tell me their were no errors. I'm running it right now from the Microsoft Visual Basic for Applications editor from Access just by using the run tab. I'm currently trying to set up a button in Access because i've read that sometimes that helps the code run smoothly? Still getting a 424 and a 76 error. I'm completely dumbfounded right now.

Sub MakeDir(sDrive As String, sDir As String)
On Error GoTo ErrorFound
VBA.FileSystem.MkDir sDrive & ":" & sDir
ErrorFound:
If Err.Number = 75 Then
 MsgBox "Err 75 - Directory (" & sDrive & ":" & sDir & ") already exists"
ElseIf Err.Number <> 0 Then
 MsgBox Err.Number & " other error " & Err.Description
Else
 MsgBox "Successfully created directory  " & sDir, vbOKOnly
End If

End Sub

Sub test()
MakeDir "C", "\users\me\documents\TestFolder\Test1"

On Error GoTo ErrorFound
VBA.FileSystem.MkDir sDrive & ":" & sDir
ErrorFound:
If Err.Number = 75 Then
 MsgBox "Err 75 - Directory (" & sDrive & ":" & sDir & ") already exists"
Else
MsgBox Err.Number & " other error " & Err.Description
End If
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim rs As DAO.Recordset
Dim strPath As String
Dim iRecCount As Integer
Dim iFolderCount As Integer
Set db = CurrentDb()
    Set td = db.TableDefs("Super_Test_upload")
    Set rs = td.OpenRecordset
    iRecCount = 0
    iFolderCount = 1
    strPath = "C:\users\me\documents\TestFolder"
Do Until rs.EOF = True
    strPath = strPath & Format(iFolderCount, "0000")
    iRecCount = iRecCount + 1
    Close #1
    Open "c:\users\me\documents\TestFolder\Test1" & "\" & RTrim(rst!productcode) & ".txt" For Output As #1
   Print #1, RTrim(rst!LOTSOFCOLUMNS!)
   Close #1
   rs.MoveNext
    If iRecCount > 1000 Then
        iRecCount = 0
        iFolderCount = iFolderCount + 1
    End If
    Loop
End Sub

 

[jdraw]

Error 76
This particular runtime error means "path not found." In simple terms, it means that the program cannot identify the correct location for writing its data. When that happens, the program does not know where to look, so it usually crashes or freezes.

Article Source: http://EzineArticles.com/1254447


I'll try mock something up and see if I have any luck.

Just looked at your code. You Dim rs, but you try to use rst??

 

[RCesto]

Right now it looks like my problem has something to do with

  strPath = strPath & Format(iFolderCount, "0000") and the Open strPath & "\" & RTrim(rst!productcode) & ".txt" For Output As #1

. After removing the str = path & Format it ran but bumped up against the file limit. But when I put it back in it started showing the 76 error on the Open strPath & "\" & RTrim(rst!productcode) & ".txt" line again.

 

[jdraw]

I mocked up a version. Only 5 test records, each with 4 fields.
Inm my test I changed subdirectory every 2 records, I outputted the 4 fields. Each field had Rtrim and fields are separated with "vbCrLF"
Here's the code -adjust as you see fit.

'---------------------------------------------------------------------------------------
' Procedure : testFilesToFolders
' Author    : Jack
' Date      : 20/02/2013
' Purpose   : This is a modification of code posted by RCesto
'http://www.access-programmers.co.uk/forums/showthread.php?t=230404&page=2  post #17
'
' I am using a variable sDirBase and in my test I make a new subdorectory every 2 records
' You can change the values to suit your needs.
' In my Super_Test_Upload  I  had 5 test records.
'---------------------------------------------------------------------------------------
'
Sub testFilesToFolders()

    Dim sDirBase As String
    Dim db As DAO.Database
    Dim td As DAO.TableDef
    Dim rs As DAO.Recordset
    Dim strPath As String
    Dim iRecCount As Integer
    Dim iFolderCount As Integer
    On Error GoTo testFilesToFolders_Error

    Set db = CurrentDb()
    Set td = db.TableDefs("Super_Test_upload")
    Set rs = td.OpenRecordset
    iRecCount = 0
    iFolderCount = 1
    'strPath = "C:\users\me\documents\TestFolder"
    sDirBase = "\users\jack\documents\TestFolder\Test"

    '** Make a subdirectory to start
    makedir "C", sDirBase & Format(iFolderCount, "0000")  'make the first sub directory here

    '** Create a new directory every 2 records TEST
    Do Until rs.EOF = True
        strPath = sDirBase & Format(iFolderCount, "0000")  'use the sub directory here
        iRecCount = iRecCount + 1
        Close #1
        Open strPath & "\" & RTrim(rs!ProductCode) & ".txt" For Output As #1

        'In my test I have 4 fields fld1-fld4
        Print #1, RTrim(rs!fld1) & vbCrLf & RTrim(rs!fld2) & vbCrLf & RTrim(rs!fld3) & vbCrLf & RTrim(rs!fld4)
        Close #1
        rs.MoveNext

        'My test make a new folder every 2 records MyTest
        'If iRecCount > 1000 Then
        If iRecCount > 1 Then
            iRecCount = 0
            iFolderCount = iFolderCount + 1
            makedir "C", sDirBase & Format(iFolderCount, "0000")    'time to make a new subdirectory
            strPath = sDirBase & Format(iFolderCount, "0000")  'this line is redundant
        End If
    Loop
    MsgBox "Finished new folders created " & iFolderCount

    On Error GoTo 0
    Exit Sub

testFilesToFolders_Error:

    MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure testFilesToFolders of Module AWF_Related"
End Sub

I have attached a jpg of my directory and subdirectory and some files that were created.

Good luck.