|
我是先合并表,然后打算删除掉空表,但空表有关系,怎么办
============================
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
================================================ |
|