MS Access VBA Create Sample Table for versions 2000, 2002, 2003, 2007

Function MAKE_SAMPLE_TABLE(TableName As String ) As Boolean
   'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
   'Set references by Clicking Tools and Then References in the Code View window
   'Creates a Text field, other data types listed
   '
   ' TableName : Name of table in which to create the sample from
   '
   ' Returns True on success, false otherwise
   '
   'USAGE: MAKE_SAMPLE_TABLE "TABLENAME"

   On Error GoTo errhandler

   Dim intNum As Integer , RecCount As Long
   Dim rs As DAO.Recordset, Db As DAO.Database
   Dim strDate As String , mystr As String , mydate As String , dbNamed As String
   Dim stIinptNum As String , samSql As String , Samp As String

   'Check for table to get sample from
   If ifTableExists(TableName) = False Then
      MsgBox "You must choose an existing table to create samples from."
      Exit Function
   End If

   'Check for Long integer field with Unique values
   If ifFieldExists( "CNT" , TableName) = False Then
      'Add Autonumber field (Long integer field with Unique values)
      CreateAutoNumberField TableName, "CNT"
   End If

   If ifFieldExists( "RAND" , TableName) = False Then
      'Add Datatype Double field
      CreateField TableName, "RAND"
   End If

   'Set the SQL String to UPDATE our RAND field(Long integer field [CNT] with
   'Unique values becomes the Seed for our RND() Function)
   samSql = "UPDATE [" & TableName & "] SET [" & TableName & "].RAND = Rnd([CNT]);"
   Debug.Print samSql
   Set Db = CurrentDb() 

   'Run the UPDATE SQL Query for the Datatype Double Field using the RND() Function
   Db.Execute samSql

   'Number of records Variable
   intNum = 0

   Set rs = Db.OpenRecordset( "SELECT CNT FROM [" & TableName & "]" , dbOpenDynaset, dbReadOnly)
   rs.MoveLast

   'Get record Count
   RecCount = rs.RecordCount

   'Get Number of Records info
   stIinptNum = InputBox( "Please enter Number of records less than" & RecCount & "." ,  "Enter Number" , "" )
   rs.Close 
   
   'Check if stIinptNum greater than zero and less than or equal to Number of records
   If Len(stIinptNum) > 0 And stIinptNum <= RecCount Then

      'Set Number Variable equal to InputBox Answer
      intNum = stIinptNum
   End If

   If Len(intNum) = 0 Or intNum = 0 Then
      Exit Function
   End If 

   'Set Sample SQL string to grab the TOP nth records with our chosen fields
   Samp = "SELECT TOP " & intNum & " [" & TableName & "].COMPANY, [" & TableName & "].ADDRESS, [" & TableName & _
         "].CITY, [" & TableName & "].STATE, [" & TableName & "].ZIP INTO 1SAMPLE " & _
         "FROM [" & TableName & "] " & _
         "ORDER BY [" & TableName & "].RAND DESC;"

   'Check for a previous sample of the same Table name
   If ifTableExists( "1SAMPLE" ) = True Then
      'delete the sample table if found
      Db.Execute "DROP TABLE " & "1SAMPLE"
   End If
   Debug.Print Samp
   Db.Execute Samp
   strDate = vbNullString

   'Set date for Table name
   mydate = Date
   mystr = Format(mydate, "mmddyy" )
   strDate = strDate & "_" & mystr & "_"
   'strDate = Replace(strDate, "/", "")

   tmLen = Len(strDate)

   'Grab user information for the Table Name
   strDate = InputBox( "Please enter a name for the file." , "Enter Name" , "" ) & strDate
   'Check user information
   If tmLen = Len(strDate) Then
      'Exit if user declines to enter any
      Exit Function
   End If

   'Set Name variable for export
   dbNamed = strDate

   'Export Sample to Excel and then Launch Excel
   DoCmd.OutputTo acOutputTable, "1SAMPLE" , acFormatXLS, "c:\" & dbNamed & "SAMPLE.xls" , True

   MAKE_SAMPLE_TABLE = True

ExitHere:

   Set rs = Nothing
   Set Db = Nothing

   Exit Function

errhandler:
   MAKE_SAMPLE_TABLE = False

   With Err
      MsgBox "Error " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, "MAKE_SAMPLE_TABLE"
   End With

   Resume ExitHere
End Function