





Function AttachExcel( _
    ByVal sFileName As String, _
    ByVal sTableName As String, _
    ByVal sRangeName As String _
    ) As Boolean
  
  Const conCannotOpen = 3432
  Const conNotRange = 3011
  Const conTableExists = 3012

  Dim db As DAO.Database
  Dim td As DAO.TableDef
  
  Dim sConnect As String
  Dim sMsg As String
  Dim sFunction As String
  
On Error GoTo HandleError
  
  AttachExcel = False
  sFunction = AttachExcel
  
   Check for existence of worksheet:
  sFileName = CurDir() & \ & sFileName
  
   If the file isnt found, notify
   the user and exit the procedure:
  If Len(Dir(sFileName)) = 0 Then
    MsgBox The file  & sFileName _
        &  could not be found
    MsgBox Please move the file to  _
        & CurDir() &  to continue
    Exit Function
  End If
  Set db = CurrentDb
  
   Create a new tabledef in the current database:
  Set td = db.CreateTableDef(sTableName)
  
   Build connect string:
  sConnect = Excel 8.0;HDR=YES;DATABASE= & sFileName
  td.Connect = sConnect
  
   Specify Range Name sRangeName:
  td.SourceTableName = sRangeName
  
   Append new linked table to TableDefs collection:
  db.TableDefs.Append td
  
  'Return True:
  AttachExcel = True
  
ExitHere:
  
  Exit Function
  
HandleError:
  
  Select Case Err
    Case conCannotOpen
        sMsg = Cannot open  & sFileName
  
    Case conTableExists
        sMsg = The table  & sTableName & _
              already exists.
  
    Case conNotRange
        sMsg = Cant find the  & sRangeName &  range.
  
    Case Else
        sMsg = Error# & Err & :  & Error$
  
  End Select
  
  MsgBox sMsg, vbExclamation + vbOKOnly, _
       Error in Procedure  & sFunction
  
  AttachExcel = False
  Resume ExitHere
  
End Function












Function LinkText( _
    ByVal sFileName As String, _
    ByVal sDSN As String, _
    ByVal sFMT As String, _
    ByVal sHDR As String, _
    ByVal sIMEX As String, _
    ByVal sTableName As String _
    ) As Boolean
    
  Dim db As DAO.Database
  Dim td As DAO.TableDef
  Dim x As Integer
  Dim sType As String
  Dim sPath As String
  Dim sPathAndFileName As String
  Dim sDatabase As String
  Dim sConnect As String
  Dim sMsg As String
  Dim sFunction As String
  Const conTableExists = 3012
  
On Error GoTo HandleError
  
  LinkText = False
  sFunction = LinkTxt
  
   Check for existence of file:
  sPath = CurDir() & \
  sDatabase = sPath & sFileName
  
  If Len(Dir(sDatabase)) = 0 Then
    MsgBox The File  & sFileName & _
           could not be found
    MsgBox Copy the file to  & CurDir() _
           &  to continue
    Exit Function
  End If
  
   Create Tabledef:
  Set db = CurrentDb
  Set td = db.CreateTableDef(sTableName)
  
  sType = Text;
  sDSN = DSN= & sDSN & ;
  sFMT = FMT= & sFMT & ;
  sHDR = HDR= & sHDR & ;
  sIMEX = IMEX= & sIMEX & ;
  
  sDatabase = DATABASE= & sPath
  sConnect = sType & sDSN & sFMT & sHDR & sIMEX & sDatabase
  
  td.Connect = sConnect
  td.SourceTableName = sFileName
  db.TableDefs.Append td
  
  LinkText = True
  
ExitHere:
  
  Exit Function
  
HandleError:
  
  Select Case Err
    
    Case conTableExists
        sMsg = The table  & sTableName _
            &  already exists.
    
    Case Else
        sMsg = Error# & Err & :  & Error$
    
  End Select
  
  MsgBox sMsg, vbExclamation + vbOKOnly, _
       Error in Procedure  & sFunction
  
  LinkText = False
  Resume ExitHere
  
End Function 



Function TestLink(sTablename As String) As Boolean
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim iStartODBC As Integer
  Dim iEndODBC As Integer
  Dim sDataSrc As String
  Dim iODBCLen As Integer
  Dim sMessage As String
  Dim iReturn As Integer
  
On Error GoTo HandleError
  
  Set db = CurrentDb
  
  Open a recordset to force an error:
  Set rs = db.OpenRecordset(sTablename)
  
  If the link is valid, exit the function:
  TestLink = True
  
  rs.Close
  
ExitHere:
  
  Exit Function
  
HandleError:
  If the link is bad, determine what the problem 
  is, let the user know, and exit the function:
  Select Case Err
      
      Case 3078    Table doesnt exist:
      
          sMessage = Table  & sTablename _
               &  does not exist in this database
      
      Case 3151    Bad link
          Extract the name of the odbc DSN
          to use in your custom error message:
          iStartODBC = InStr(Error, to ) + 4
          
          iEndODBC = InStr(Error,  failed)
          iODBCLen = iEndODBC - iStartODBC
          
          sDataSrc = Mid$(Error, iStartODBC, iODBCLen)
          
          sMessage = Table  & sTablename _
               &  is linked to ODBC datasource  _
               & sDataSrc _
               &  which is not available at this time
      
      Case Else
          sMessage = Error\Err.Description
      
  End Select
  
  iReturn = MsgBox(sMessage, vbOKOnly)
  
  Return failure:
  TestLink = False
  
  Resume ExitHere
  
End Function
