• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• copies a folder, deletes tables from database, links tables from another database

copies a folder, deletes tables from database, links tables from another database

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




Rate copies a folder, deletes tables from database, links tables from another database

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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