Separando dados de um arquivo constantemente anexado em um novo arquivo

' Export the Table "Orders" to "orders.csv", appending the data to the       '
' existing file if there is one.                                             '
ExportQueryToCSV "Orders", "C:\orders.csv", AppendToFile:=True

' Export the result of the query to "stock.csv" using tabs as delimiters     '
' and no header or quotes around strings                                     '
ExportQueryToCSV "SELECT * FROM Stock WHERE PartID=2", _
                 "C:\stock.csv", _
                 AppendToFile:=False, _
                 IncludeHeader:=False, _
                 Delimiter:=chr(9), _
                 QuoteString:=false

'----------------------------------------------------------------------------'
' Export the given query to the given CSV file.                              '
'                                                                            '
' Options are:                                                               '
' - AppendToFile : to append the record to the file if it exists instead of  ' 
'                  overwriting it (default is false)                         '
' - Delimiter    : what separator to use (default is the coma)               '
' - QuoteString  : Whether string and memo fields should be quoted           '
'                  (default yes)                                             '
' - IncludeHeader: Whether a header with the field names should be the first '
'                  line (default no)                                         '
' Some limitations and improvements:                                         '
' - Memo containing line returns will break the CSV                          '
' - better formatting for numbers, dates, etc                                '
'----------------------------------------------------------------------------'
Public Sub ExportQueryToCSV(Query As String, _
                            FilePath As String, _
                            Optional AppendToFile As Boolean = False, _
                            Optional Delimiter As String = ",", _
                            Optional QuoteStrings As Boolean = True, _
                            Optional IncludeHeader As Boolean = True)
    Dim db As DAO.Database
    Dim rs As DAO.RecordSet

    Set db = CurrentDb
    Set rs = db.OpenRecordset(Query, dbOpenSnapshot)
    If Not (rs Is Nothing) Then
        Dim intFile As Integer

        ' Open the file, either as a new file or in append mode as required '
        intFile = FreeFile()
        If AppendToFile And (Len(Dir(FilePath, vbNormal)) > 0) Then
            Open FilePath For Append As #intFile
        Else
            Open FilePath For Output As #intFile
        End If

        With rs
            Dim fieldbound As Long, i As Long
            Dim record As String
            Dim field As DAO.field

            fieldbound = .Fields.count - 1

            ' Print the header if required '
            If IncludeHeader Then
                Dim header As String
                For i = 0 To fieldbound
                    header = header & .Fields(i).Name
                    If i < fieldbound Then
                        header = header & Delimiter
                    End If
                Next i
                Print #intFile, header
            End If

            ' print each record'
            Do While Not .EOF
                record = ""
                For i = 0 To fieldbound
                    Set field = .Fields(i)
                    If ((field.Type = dbText) Or (field.Type = dbMemo)) And QuoteStrings Then
                        record = record & """" & Nz(.Fields(i).value, "") & """"
                    Else
                        record = record & Nz(.Fields(i).value)
                    End If
                    If i < fieldbound Then
                        record = record & Delimiter
                    End If
                    Set field = Nothing
                Next i
                Print #intFile, record
                .MoveNext
            Loop
            .Close
        End With
        Set rs = Nothing
        Close #intFile
    End If
    Set rs = Nothing
    Set db = Nothing
End Sub