Public Sub RSTToCSV(ByVal RstADO As ADODB.Recordset, Optional ByVal STR_DELIM As String = ",")
Dim FreeF               As Long
Dim DF                  As String
Dim StrCSV              As String
Dim FldADO              As ADODB.Field
Dim FileModifyer        As String
    With RstADO
        If Not .EOF Then
            For Each FldADO In .Fields
                StrCSV = StrCSV & FldADO.Name & STR_DELIM
            Next
            StrCSV = Left$(StrCSV, Len(StrCSV) - 1) & vbNewLine
            StrCSV = StrCSV & .GetString(adClipString, -1, STR_DELIM, vbNewLine)
            DF = ThisWorkbook.Path & "\MyFile" & FileModifyer & ".csv"
            If Len(Dir$(DF)) > 0 Then
                Do Until Len(Dir$(DF)) = 0
                    If Len(FileModifyer) = 0 Then
                        FileModifyer = "0"
                    End If
                    FileModifyer = CStr(CLng(FileModifyer) + 1)
                    DF = ThisWorkbook.Path & "\MyFile" & FileModifyer & ".csv"
                Loop
            End If
            FreeF = FreeFile
            Open DF For Binary Access Write As #FreeF
            Put #FreeF, , StrCSV
            Close #FreeF
        End If
        .Close
    End With
End Sub

RSTToCSV rs