by Archie P. Cone III (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 7th May 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
copies a folder, deletes tables from database, links tables from another database
API Declarations
Dim FolderName As String
Dim dbname As String
Dim Design As String
Dim Eng As String
Dim x1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim DESIGNREPORTS As Database
Dim engreports As Database
Dim MASTER As String
Dim engcn As ADODB.Connection
Dim engcat As ADOX.Catalog
Dim engtbl As ADOX.Table
Dim tablename As String
Dim suitecat As ADOX.Catalog
Dim suitecn As ADODB.Connection
Dim suitetbl As ADOX.Table
Dim designcat As ADOX.Catalog
Dim designcn As ADODB.Connection
Dim designtbl As ADOX.Table
VBcoders
ProgressBar1.Visible = True
' COPYS MASTER FROM 9999 DIRECTORY
Set Obj = CreateObject("Scripting.FileSystemObject")
FolderName = txtFolder.Text & "\Electrical Suite"
dbname = FolderName & "\Electrical Suite.mdb"
Design = FolderName & "\EICableReports.mdb"
Eng = FolderName & "\LOADLISTREPORTS.MDB"
MASTER = "U:\9999\elec\ELECTRICAL SUITE\ELECTRICAL SUITE"
Obj.createfolder FolderName
Obj.CopyFolder MASTER, FolderName, True
ProgressBar1.Value = 20
' DELETES ALL RECORDS FROM MASTER
Set x1 = OpenDatabase(dbname, False, False, "")
Set rs1 = x1.OpenRecordset("mcc")
''''''''''''''''''''''''''''''CLEARS OUT OLD DATA'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs1.RecordCount > 0 Then
rs1.MoveFirst
While Not rs1.EOF
rs1.Delete
rs1.MoveNext
Wend
End If
ProgressBar1.Value = 30
''''''''''''''''''''''''''''DELETES OLD LINKS''''''''''''''''''''''''''
ProgressBar1.Value = 60
Set DESIGNREPORTS = OpenDatabase(Design, False, False, "")
DESIGNREPORTS.TableDefs.Delete ("13200 VOLT MOTORS")
")
ProgressBar1.Value = 100
engreports.Close
DESIGNREPORTS.Close
'''''''''''''''''''''' LINKS THE TABLES''''''''''''''''''''''''
Set engcn = New ADODB.Connection
engcn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Eng & ""
Set suitecn = New ADODB.Connection
suitecn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbname & ""
Set engcat = New ADOX.Catalog
Set suitecat = New ADOX.Catalog
' Open the catalog.
engcat.ActiveConnection = engcn
suitecat.ActiveConnection = suitecn
For Each suitetbl In suitecat.Tables
If suitetbl.Type = "TABLE" Then
Set engtbl = New ADOX.Table
tablename = suitetbl.Name
' Create the new Table.
engtbl.Name = tablename
Set engtbl.ParentCatalog = engcat
Set designtbl.ParentCatalog = designcat
' Set the properties to create the link.
engtbl.Properties("Jet OLEDB:Link Datasource") = dbname
engtbl.Properties("Jet OLEDB:Remote Table Name") = tablename
engtbl.Properties("Jet OLEDB:Create Link") = True
designtbl.Properties("Jet OLEDB:Link Datasource") = dbname
designtbl.Properties("Jet OLEDB:Remote Table Name") = tablename
designtbl.Properties("Jet OLEDB:Create Link") = True
' Append the table to the Tables collection.
engcat.Tables.Append engtbl
designcat.Tables.Append designtbl
End If
Next
End
End Sub
Private Sub Dir1_Change()
File1 = Dir1
txtFolder = Dir1
End Sub
Private Sub Drive1_Change()
Dir1 = Drive1
End Sub
Private Sub Form_Load()
Drive1.Drive = "C"
End Sub
No comments have been posted about copies a folder, deletes tables from database, links tables from another database. Why not be the first to post a comment about copies a folder, deletes tables from database, links tables from another database.
