by S.Touseef Ali (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 2nd November 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This Utility Program Is Used To Delete The Data From Your Databases Tables. Just Select The Database From Combo Box And Then Checked The
API Declarations
Dim sqlSer As New SQLDMO.SQLServer
Dim sqlDatabase As New SQLDMO.Database
Dim sqlTable As New SQLDMO.Table
Dim sqlApp As New SQLDMO.Application
Dim sqlNameList As SQLDMO.NameList
'RECORDSETS AND CONNECTION OBJECTS
Dim cn As New ADODB.Connection
'Variables
Dim bolCheck As Boolean, bolRemainingTables As Boolean, intCorruptTables As Integer
VBcoders
If bolCheck = False Then Exit Sub
Select Case Index
Case 0 'Servers
If sqlSer.IsLogin("sa") = True Then
sqlSer.Disconnect
sqlSer.Connect cbofield(0).Text, "sa", ""
End If
'Filling Databases Name
cbofield(1).Clear
For Each sqlDatabase In sqlSer.Databases
If Not sqlDatabase.SystemObject Or (chkSystemDB <> 0) Then
cbofield(1).AddItem sqlDatabase.Name
End If
Next
If cbofield(1).ListCount > 0 Then cbofield(1).Text = cbofield(1).List(0)
Case 1 'Databases
'Filling Tables Name
lstBox.Clear
For Each sqlTable In sqlSer.Databases(Trim(cbofield(1).Text)).Tables
If Not sqlTable.SystemObject Or (chkSystemDB <> 0) Then
lstBox.AddItem sqlTable.Name
End If
Next
End Select
End Sub
Private Sub cbofield_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 0
If KeyAscii = 13 Then Call cbofield_Click(Index)
End Select
End Sub
Private Sub cmdButton_Click(Index As Integer)
Select Case Index
Case 0 'Delete
Call DeleteTablesData
If prgBar.Value > 0 Then
MsgBox prgBar.Value & "Tables Have Deleted Successfully!", vbInformation
Else
MsgBox "Process Complete Without Deletion!", vbInformation
End If
Case 1 'Exit
Unload Me
End Select
End Sub
Private Sub Form_Load()
On Error GoTo ErrorHandler
Dim x As Long
bolCheck = False: bolRemainingTables = False
'Filling Servers Name
Set sqlNameList = sqlApp.ListAvailableSQLServers
For x = 1 To sqlNameList.Count
cbofield(0).AddItem UCase(sqlNameList.Item(x))
Next
If cbofield(0).ListCount > 0 Then cbofield(0).Text = cbofield(0).List(0)
'Conneting
sqlSer.Connect cbofield(0).Text, "sa", ""
'Filling Databases Name
For Each sqlDatabase In sqlSer.Databases
If Not sqlDatabase.SystemObject Or (chkSystemDB <> 0) Then
cbofield(1).AddItem sqlDatabase.Name
End If
Next
If cbofield(1).ListCount > 0 Then cbofield(1).Text = cbofield(1).List(0)
'Filling Tables Name
For Each sqlTable In sqlSer.Databases(Trim(cbofield(1).Text)).Tables
If Not sqlTable.SystemObject Or (chkSystemDB <> 0) Then
lstBox.AddItem sqlTable.Name
End If
Next
bolCheck = True
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
'Sub Routine For Deleting Tables Data
Public Sub DeleteTablesData()
On Error GoTo checkError
If bolRemainingTables = False Then
If cn.State = 1 Then Set cn = Nothing
cn.ConnectionString = "Provider=SQLOLEDB.1;User ID=sa;" _
& "Initial Catalog=" & Trim(cbofield(1).Text) & ";Data Source=" & cbofield(0).Text
cn.Open
prgBar.Min = 0: prgBar.Max = lstBox.SelCount
End If
If intCorruptTables > sqlSer.Databases(Trim(cbofield(1).Text)).Tables.Count - 1 Then
MsgBox "Some Tables Data Cannot Delete Because They Are Refrenced With Each Other!"
End
End If
bolRemainingTables = False
For Each sqlTable In sqlSer.Databases(Trim(cbofield(1).Text)).Tables
If sqlTable.SystemObject = False Then
If IsMasterTable(sqlTable.Name) = False Then
cn.Execute "DELETE FROM " & sqlTable.Name
prgBar.Value = prgBar.Value + 1
End If
End If
Next
If bolRemainingTables = True Then Call DeleteTablesData
checkError:
If Err.Number = -2147217900 Or Err.Number = -2147217873 Then
bolRemainingTables = True
intCorruptTables = intCorruptTables + 1
Resume Next
ElseIf Err.Number = 380 Then 'when prgBar.Value > prgBar.Max
Resume Next
ElseIf Err.Number = -2147217871 Then 'for connection time out expired
bolRemainingTables = True
Resume Next
ElseIf Err.Number = 0 Then
Exit Sub
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Public Function IsMasterTable(ByVal tblName As String) As Boolean
Dim intx As Integer
For intx = 0 To lstBox.ListCount - 1
If lstBox.Selected(intx) = True Then
If tblName = lstBox.List(intx) Then
IsMasterTable = False
Exit Function
End If
End If
Next
IsMasterTable = True
End Function
No comments have been posted about This Utility Program Is Used To Delete The Data From Your Databases Tables. Just Select The Databas. Why not be the first to post a comment about This Utility Program Is Used To Delete The Data From Your Databases Tables. Just Select The Databas.
