VBA/Excel/Access/Word/Access/Recordset Save

Copy Records to a Text File

   <source lang="vb">

Sub WriteToFile()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim f As ADODB.Field
  Dim myFileSystemObject As Object
  Dim txtfile As Object
  Set conn = New ADODB.Connection
  conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
  Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
  Set txtfile = myFileSystemObject.CreateTextFile("c:\testfile.txt", True)
  Set myRecordset = New ADODB.Recordset
  myRecordset.Open "[Order Details]", conn
  With myRecordset
     For Each f In .Fields
        txtfile.Write (f.Name)
        txtfile.Write Chr(9)
     Next
     txtfile.WriteLine
     txtfile.Write myRecordset.GetString(adClipString)
     .Close
  End With
  txtfile.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Saving Records to a Disk File

   <source lang="vb">

Sub SaveRecordsToDisk()

   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim strFileName As String
   Dim strNorthPath As String
   strFileName = CurrentProject.Path & "\Companies.rst"
   strNorthPath = CurrentProject.Path & "\mydb.mdb"
    On Error GoTo ErrorHandle
    Set conn = New ADODB.Connection
    With conn
         .Provider = "Microsoft.Jet.OLEDB.4.0"
         .ConnectionString = "Data Source = " & strNorthPath
         .Mode = adModeReadWrite
         .Open
     End With
    Set myRecordset = New ADODB.Recordset
    With myRecordset
       .CursorLocation = adUseClient
       .Open "Customers", conn, adOpenKeyset, adLockBatchOptimistic, adCmdTable
       .ActiveConnection = Nothing
       .Save strFileName, adPersistADTG
       .Close
     End With
     Debug.Print "Records were saved in " & strFileName & "."

ExitHere:

   Set myRecordset = Nothing
   Exit Sub

ErrorHandle:

   If Not IsEmpty(Dir(strFileName)) Then
     Kill strFileName
     Resume
   Else
     MsgBox Err.Number & ": " & Err.Description
     Resume ExitHere
   End If

End Sub

</source>