Graham, thanks for you reply. I did not know about that method. However,
I
don't think a query will be able to create the hoizontal format needed.
Turns out also that they wanted different limitors between different
pieces.
Here was I came up with for a command button:
On Error GoTo ErrorHandler
'Set the environment and variables
Dim lngLFile As Long, strLFile As String
Dim db As DAO.Database, rst As DAO.Recordset, rst1 As DAO.Recordset
Dim varString As Variant
Dim strDate As String 'used
to
format today's date to yyyymmdd format
Dim dteDate As Date 'used
to
get the youngest collection date for a pool
Dim lngRCnt As Long, lngCount 'count
how many pools in shipment, how many pools should be in text file
Dim strPool As String
Dim strDate1 As String 'used
to
format the collection date to yyyyMMdd format
'Format today's date for client format
strDate = Format(Date, "yyyymmdd")
'Set database and recordset variables
Set db = CurrentDb()
Format
'Grouped query used to get the list of pools and the most recent date
within
each pool
Set rst = db.OpenRecordset("SELECT * FROM qryPoolsByTAD WHERE ShipDate =
#"
& Date & "#", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveLast
'Create manifest text file
lngLFile = FreeFile
Open UDMANDIR & strDate & "_NG5874_NG5874_XXX_man" & ".txt" For Output
As lngLFile
lngCount = rst.RecordCount 'how many pools should be in
the
text files
rst.MoveFirst
lngRCnt = 0 'initialize record count
'Loop through rst recordset
Do Until rst.EOF = True
strPool = rst![tubeid]
dteDate = rst![TAD] 'TAD = Test after date for the
pool
strDate1 = Format(Date, "yyyymmdd") 'format TAD for client
'create a recordset of members for the each pool stored in rst
Set rst1 = db.OpenRecordset("SELECT UnitID FROM tblConstits WHERE
TubeID = '" & strPool & "'")
rst1.MoveLast
If rst1.RecordCount <> 0 Then
rst1.MoveFirst
varString = ""
Do Until rst1.EOF = True
'create the string variable
If varString = "" Then
varString = strPool & "," & strDate1 & "," &
rst1![UnitID]
Else
varString = varString & ";" & rst1![UnitID]
End If
rst1.MoveNext
Loop
End If
'Write the information to the file and increment record counter
Print #lngLFile, varString
lngRCnt = lngRCnt + 1
rst.MoveNext
Loop
Print #lngLFile, lngRCnt & " records listed."
Else
MsgBox "There are no records to export for today.", vbOKOnly +
vbInformation, "No Records"
GoTo Release_Objects
End If
MsgBox "Done." & Chr(10) & Chr(10) & "There were " & lngCount & " pools
ready for export and there were " & lngRnt & " records exported."
'Release objects from memory
Release_Objects:
rst.Close
db.Close
Set rst = Nothing
Set rst1 = Nothing
Set db = Nothing
Close
Reset
Exit_Sub:
Exit Sub
ErrorHandler:
MsgBox "Error #" & Err.Number & " - Description: " & Err.Description,
vbOKOnly + vbExclamation, "Error"
Resume Release_Objects
Graham R Seach said:
LeAnn,
Rather than loop through the recordset, which will be slow, you might
want
to take a look at the TransferText method, which will allow you to export
the contents of a query to many formats, include CSV. Just create a query
containing all the fields you want to export, then call the TransferText
method in VBA.
DoCmd.TransferText acExportDelim, , "qryMyQuery", "c:\Temp\myFile.csv",
False
Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia