[RESOLVED] Check table exists in Access

[c03cg]

Is there any way to check if a table exist aand if so delete it?
I was thinking this might do it:

If CurrentDb.TableDefs(TempTable).Name > "" Then
     DoCmd.RunSQL "DROP TABLE TempTable;"
End If

but that hangs!

[RhinoBull]

That's because (I think) Access doesn't support "DROP TABLE...".
Isn't there CurrentDb.TableDefs.Delete "TableName" syntax or similar ???

[c03cg]

It does accept the DROP TABLE bit... Thats in my code and executes fine... i just wanted a backup at the start of the code incase the application had been ended midway through the code

[RobDog888]

Nope, you cant do it that way because you will generate a "Item not found in collection" error if it doesnt exist.

Also, DROP TABLE... is supported.

'You can .Delete a table this way...
CurrentDb.TableDefs.Delete ("Table3")
 
'You can iterate through the TableDefs collection looking for a match
Dim i As Integer
For i = 1 To CurrentDb.TableDefs.Count
    If CurrentDb.TableDefs(i).Name = "Table3" Then
        MsgBox "Table3 Exists!"
        Exit For
    End If
Next

And finally you can just error trap for the existance of the table in the collection.

On Error GoTo MyError
If CurrentDb.TableDefs(TempTable).Name = "Table3" Then
    MsgBox "Table Exists"
End If
Exit Sub
MyError:
    Msgbox "Table Does Not Exist"

[c03cg]

Cheers Rob,

ive now got:

For i = 1 To CurrentDb.TableDefs.Count
        On Error GoTo Start
        If CurrentDb.TableDefs(i).Name = "TempTable" Then
            CurrentDb.TableDefs.Delete ("TempTable")
            Exit For
        End If
    Next
Start:

which works beautifully!

[RobDog888]

Thanks but you really dont need the "On Error GoTo Start" since we are iterating through the collection using the Index position instead of its Name.

[c03cg]

Once again you are right, although for some reson the first time i did that it screwed up... it works anyhow.

Thanks again!

[c03cg]

Sorry.... it's now still failing without the on error statement.... it runs through the loop but stops at the end of the loop and doesnt execute any more code!...

[RobDog888]

Post what your code looks like.

[c03cg]

Public Function exportData(pPath As String, pDataSource As Integer)
 
On Error GoTo Err_exportData
 
    DoCmd.SetWarnings False
    
    Dim oApp As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oWS As Excel.Worksheet
    Dim i, j, tDataSource As Integer
    Dim tPath, tTemp, tSQL As String
    Dim tResult As VbMsgBoxResult
    
    For i = 1 To CurrentDb.TableDefs.Count
        On Error GoTo Start
        If CurrentDb.TableDefs(i).Name = "TempTable" Then
            CurrentDb.TableDefs.Delete ("TempTable")
            Exit For
        End If
    Next
 
Start:
    If Not Len(Dir(pPath, vbDirectory)) > 0 Then
        MkDir pPath
    End If
    
    If Not pDataSource = -1 Then
        tDataSource = pDataSource
    Else
        tDataSource = 5
    End If
    
    tSQL = Switch(tDataSource = 0, "SELECT pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction, behaviour.Reason, behaviour.ExclusionLength, teacher.TeacherName, faculty.FacultyName, period.Period INTO TempTable FROM teacher INNER JOIN (Sanctions INNER JOIN (pupils INNER JOIN (period INNER JOIN (faculty INNER JOIN behaviour ON faculty.FacultyID = behaviour.FacutyID) ON period.PeriodID = behaviour.PeriodID) ON pupils.PupilID = behaviour.PupilID) ON Sanctions.SanctionID = behaviour.SanctionID) ON teacher.TeacherID = behaviour.TeacherID WHERE (((pupils.Year)=7)) ORDER BY pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction;", _
                tDataSource = 1, "SELECT pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction, behaviour.Reason, behaviour.ExclusionLength, teacher.TeacherName, faculty.FacultyName, period.Period INTO TempTable FROM teacher INNER JOIN (Sanctions INNER JOIN (pupils INNER JOIN (period INNER JOIN (faculty INNER JOIN behaviour ON faculty.FacultyID = behaviour.FacutyID) ON period.PeriodID = behaviour.PeriodID) ON pupils.PupilID = behaviour.PupilID) ON Sanctions.SanctionID = behaviour.SanctionID) ON teacher.TeacherID = behaviour.TeacherID WHERE (((pupils.Year)=8)) ORDER BY pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction;", _
                tDataSource = 2, "SELECT pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction, behaviour.Reason, behaviour.ExclusionLength, teacher.TeacherName, faculty.FacultyName, period.Period INTO TempTable FROM teacher INNER JOIN (Sanctions INNER JOIN (pupils INNER JOIN (period INNER JOIN (faculty INNER JOIN behaviour ON faculty.FacultyID = behaviour.FacutyID) ON period.PeriodID = behaviour.PeriodID) ON pupils.PupilID = behaviour.PupilID) ON Sanctions.SanctionID = behaviour.SanctionID) ON teacher.TeacherID = behaviour.TeacherID WHERE (((pupils.Year)=9)) ORDER BY pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction;", _
                tDataSource = 3, "SELECT pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction, behaviour.Reason, behaviour.ExclusionLength, teacher.TeacherName, faculty.FacultyName, period.Period INTO TempTable FROM teacher INNER JOIN (Sanctions INNER JOIN (pupils INNER JOIN (period INNER JOIN (faculty INNER JOIN behaviour ON faculty.FacultyID = behaviour.FacutyID) ON period.PeriodID = behaviour.PeriodID) ON pupils.PupilID = behaviour.PupilID) ON Sanctions.SanctionID = behaviour.SanctionID) ON teacher.TeacherID = behaviour.TeacherID WHERE (((pupils.Year)=10)) ORDER BY pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction;", _
                tDataSource = 4, "SELECT pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction, behaviour.Reason, behaviour.ExclusionLength, teacher.TeacherName, faculty.FacultyName, period.Period INTO TempTable FROM teacher INNER JOIN (Sanctions INNER JOIN (pupils INNER JOIN (period INNER JOIN (faculty INNER JOIN behaviour ON faculty.FacultyID = behaviour.FacutyID) ON period.PeriodID = behaviour.PeriodID) ON pupils.PupilID = behaviour.PupilID) ON Sanctions.SanctionID = behaviour.SanctionID) ON teacher.TeacherID = behaviour.TeacherID WHERE (((pupils.Year)=11)) ORDER BY pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction;", _
                tDataSource = 5, "SELECT pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction, behaviour.Reason, behaviour.ExclusionLength, teacher.TeacherName, faculty.FacultyName, period.Period INTO TempTable FROM teacher INNER JOIN (Sanctions INNER JOIN (pupils INNER JOIN (period INNER JOIN (faculty INNER JOIN behaviour ON faculty.FacultyID = behaviour.FacutyID) ON period.PeriodID = behaviour.PeriodID) ON pupils.PupilID = behaviour.PupilID) ON Sanctions.SanctionID = behaviour.SanctionID) ON teacher.TeacherID = behaviour.TeacherID ORDER BY pupils.Surname, pupils.Forename, behaviour.Date, Sanctions.Sanction;")
    
    tPath = pPath
    tTemp = Right(tPath, 1)
    
    If Not tTemp = "\" Then
        If Not tTemp = "/" Then
            tPath = tPath & "\"
        End If
    End If
    
    tTemp = Switch(tDataSource = 0, "Year_7_" & Date, _
                tDataSource = 1, "Year_8_" & Date, _
                tDataSource = 2, "Year_9_" & Date, _
                tDataSource = 3, "Year_10_" & Date, _
                tDataSource = 4, "Year_11_" & Date, _
                tDataSource = 5, "Whole_School_" & Date)
                
    tPath = tPath & Replace(tTemp, "/", "_")
    
    If Len(Dir(tPath & ".xls")) > 0 Then
        '   We know that the file exists.
        tResult = MsgBox("File Already Exists, would you like to overwrite the existing file?", vbYesNo, "PK:Sanctions")
        If tResult = vbNo Then
            MsgBox "No file created", vbOKOnly
            Exit Function
        Else
            Dim tDeleteFile As String
            tDeleteFile = tPath & ".xls"
            SetAttr tDeleteFile, vbNormal
            Kill tDeleteFile
        End If
    End If
 
    Set oApp = New Excel.Application
    Set oWB = oApp.Workbooks.Add
    
    DoCmd.RunSQL ("CREATE TABLE TempTable (Surname Text(50), Forename Text(50), [Date] DateTime, Sanction Text(50), Reason Text(255), ExclusionLength Long, TeacherName Text(50), FacultyName Text(50), Period Text(50));")
    DoCmd.RunSQL (tSQL)
        
    oWB.Sheets("Sheet1").Cells(1, 1) = ""
    oWB.Close SaveChanges:=True, Filename:=tPath
        
    Set oWB = Nothing
    oApp.Quit
    Set oApp = Nothing
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "TempTable", tPath & ".xls"
    DoCmd.RunSQL ("DROP TABLE TempTable;")
        
    Set oApp = New Excel.Application
    Set oWB = oApp.Workbooks.Open(tPath & ".xls")
    
    For i = oWB.Sheets.Count To 1 Step -1
        If Not oWB.Sheets(i).Name = "TempTable" Then
            oWB.Sheets(i).Delete
        End If
    Next
    
    tTemp = Switch(tDataSource = 0, "Year_7_" & Date, _
                   tDataSource = 1, "Year_8_" & Date, _
                   tDataSource = 2, "Year_9_" & Date, _
                   tDataSource = 3, "Year_10_" & Date, _
                   tDataSource = 4, "Year_11_" & Date, _
                   tDataSource = 5, "Whole_School_" & Date)
    
    tTemp = Replace(tTemp, "/", "_")
    oWB.Sheets(1).Name = tTemp
    
    Set oWS = oWB.Worksheets(tTemp)
    
    oWS.Range("A1:I1").Select
    oWS.Range("A1:I1").Font.Bold = True
    With oWS.Range("A1:I1").Interior
        .ColorIndex = 16
        .Pattern = xlSolid
    End With
        
    If Not oWS.Cells(3, 9).Value = "" Then
        i = 3
        Do While Not oWS.Cells(i, 9).Value = ""
            With oWS.Range("A" & i & ":i" & i).Interior
                .ColorIndex = 15
                .Pattern = xlSolid
            End With
            i = i + 2
        Loop
    End If
    i = 1
    If Not oWS.Cells(2, 9).Value = "" Then
        i = 1
        Do While Not oWS.Cells(i, 9).Value = ""
            i = i + 1
        Loop
    End If
    
    If i > 2 Then
        i = i - 1
    End If
    
    oWS.Range("A1:I" & i).Select
    With oWS.Range("A1:I" & i).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With oWS.Range("A1:I" & i).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With oWS.Range("A1:I" & i).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With oWS.Range("A1:I" & i).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With oWS.Range("A1:I" & i).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    If i > 1 Then
        With oWS.Range("A1:I" & i).Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End If
    oWS.Columns("A").Insert (1)
    oWS.Cells(1, 1).Select
    oWS.Columns("A").ColumnWidth = 2.25
    oWS.Rows(1).Insert (1)
        
    oWS.Cells(1, 1).Select
    oWS.Columns.AutoFit
        
    oWB.Close SaveChanges:=True
    Set oWB = Nothing
    oApp.Quit
    Set oApp = Nothing
    
    MsgBox "File """ & tPath & ".xls"" created successfully", vbOKOnly, "PK:Sanctions"
        
Exit_exportData:
    DoCmd.SetWarnings True
    Exit Function
 
Err_exportData:
    If Err.Description = "Permission Denied" Then
        MsgBox "The file """ & tPath & ".xls"" is currently running." & vbCrLf & "Click 'Ok' to stop the export, then close the file and restart the export.", vbExclamation
    End If
    Resume Exit_exportData
    
    MsgBox Err.Description
    Resume Exit_exportData
 
End Function

[RobDog888]

? Is it working now? I see that you dont reset your error handler after the loop?

[c03cg]

Yes, it works now... should i reset the error handler... i assumed that it would be local to the loop (as in java)

[RobDog888]

You need to set it back because there is no scope in the procedure for errors. Its procedural. So after the end if the test for table existance loop place your "On Error GoTo Err_exportData" code to tell vb that from this point on use this label for handling any errors in this procedure.

[c03cg]

Oh, ok... thanks for the help