





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 isn’t 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 = “Can’t 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 doesn’t 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
