设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 801|回复: 0
打印 上一主题 下一主题

[Access本身] 如何用代码删除存在关系的表,我写的程序提示我,我要删除的表和其他表有关系,怎么

[复制链接]
跳转到指定楼层
1#
发表于 2004-4-19 22:42:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
我是先合并表,然后打算删除掉空表,但空表有关系,怎么办
============================
Option Compare Database
Option Explicit

Private Sub 确认_命令_Click()
On Error GoTo Err_确认_命令_Click
        
        table_append "基本表"
        table_delect
        DoCmd.Close
   
Exit_确认_命令_Click:
    Exit Sub

Err_确认_命令_Click:
    MsgBox Err.Description
    Resume Exit_确认_命令_Click
   
End Sub
Private Sub 取消_命令_Click()
On Error GoTo Err_取消_命令_Click


    DoCmd.Close

Exit_取消_命令_Click:
    Exit Sub

Err_取消_命令_Click:
    MsgBox Err.Description
    Resume Exit_取消_命令_Click
   
End Sub
Private Sub table_delect()
On Error GoTo table_delect_Err
Dim tdf As TableDef
Dim tabName As String, tabN As String

For Each tdf In CurrentDb.TableDefs
   
    tabName = tdf.Name
    tabN = Mid(tabName, 1, 3)
   
    If tabN = "基本表" And Len(tabName) > 3 Then
        DoCmd.DeleteObject acTable, tabName
    End If

Next tdf
table_delect_Exit:
    Exit Sub

table_delect_Err:
    MsgBox Error$
    Resume table_delect_Exit


End Sub


Private Sub table_append(tabName As String)

On Error GoTo Err_table_app
Dim tdf As TableDef
Dim cnn As ADODB.Connection
Dim ExecuteStr As String, tabName_app As String
Dim yesORno As Byte
   
    Set cnn = CurrentProject.Connection

    yesORno = 0
    tabName_app = tabName & "1"
   
    For Each tdf In CurrentDb.TableDefs
        If tdf.Name = tabName_app Then
            yesORno = yesORno + 1
            Exit For
        End If
    Next tdf
   
    If yesORno = 1 Then

        ExecuteStr = "insert into "
        ExecuteStr = ExecuteStr & tabName
        ExecuteStr = ExecuteStr & " select * from " & tabName_app
        cnn.Execute ExecuteStr
        MsgBox "已完成合并数据操作。", , "合并数据提示"
        
    Else
   
        MsgBox "没有找到提供数据的'" & tabName & "'表,请首先用[文件]菜单中,[获取外部数据]子菜单中的导入功能," & Chr(13) & _
        "导入提供数据的表,再执行合并数据操作。 ", , "合并数据提示"
        
    End If


Exit_table_app:
cnn.Close
    Exit Sub

Err_table_app:
    MsgBox Err.Description
    Resume Exit_table_app
   

End Sub

================================================
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-15 12:53 , Processed in 0.105424 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表