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
|