Public Function TextFileCreator(strTable As String, StrField As String)
'*************************************************************************************************************************
'Created by :D Crake Xcraft Limited
'Date :25th June 2009
'Arguments :strTable - Name of table being queried
' :StrField - Name of field in table acting as grouper record
'
'Purpose :Group a single table by a specified field and then use this information to create individual text files
' :based on the field being grouped.
' :The newly created text file can then be used to import the raw data from.
'Comments :Files are saved in the current project path. This can be changed by the end user to be elsewhere
'Example :TextFileCreator("TblEmployees","City")
'Issues :Does not validate the existance of the table or that the field is named correctly
'**************************************************************************************************************************
'Copywrite :There is no copywrite on this code, however, if passed on then pass on the above comments.
'**************************************************************************************************************************
Dim tPath As String
Dim tFile As String
Dim vItems As String
Dim Rs1 As DAO.Recordset
Dim Rs2 As DAO.Recordset
'This is where the files are being stored. This can be changed by the user to point to a different location
tPath = CurrentProject.Path
'Create the SQL to create a group by query sorted by the selected field
Set Rs1 = CurrentDb.OpenRecordset("Select " & StrField & " From " & strTable & " Group By " & StrField & " Order By " & StrField & ";")
'Check for any records in table
If Not Rs1.EOF And Not Rs1.BOF Then
Do Until Rs1.EOF
'Create a second SQL for the selected field contents in the grouped query
Set Rs2 = CurrentDb.OpenRecordset("Select * From " & strTable & " Where " & StrField & " ='" & Rs1(StrField) & "'")
'Create the destination path
tFile = tPath & "\" & Rs1(StrField) & ".txt"
'Check if it already exists, if so, delete it first
If Dir(tFile) <> "" Then
Kill tFile
End If
'Let the user know something is happening
'If done from the immediate window the following line is ok
Debug.Print "Working on " & tFile & ", please wait..."
'if message to appear on status bat then use the next line
DoCmd.Echo True, "Working on " & tFile & ", please wait..."
'Create a new file and Open the text file
Open tFile For Output As #1
'Loop through all the matching records for the outer recordset
Do Until Rs2.EOF
'Create a string of values for each field in the table record
'Using the Nz() function to trap any Null fields
For nindex = 0 To Rs2.Fields.Count - 1
vItems = vItems & Nz(Rs2(nindex), "") & ","
Next
'Drop the last comma from the string
vItems = Left(vItems, Len(vItems) - 1)
'Write the single record to the text file
Print #1, vItems
'go to the next record i the sub set
Rs2.MoveNext
Loop
'No more for this group so close the file
Close #1
'give the system time to close the file before moving onto the next item
DoEvents
Rs2.Close
'Go to the next record in the main query
Rs1.MoveNext
Loop
'Go to end of table
Rs1.Close
End If
'Release the memory
Set Rs1 = Nothing
Set Rs2 = Nothing
End Function