ark2000
asked on
.mdb structure synchronization script
hi,
has anyone seen or came across an asp script that would synchronize a structure between 2 databases? preferably free =)
not the content just everything else, such as tables, fields, keys and so on...
thanks,
ark
has anyone seen or came across an asp script that would synchronize a structure between 2 databases? preferably free =)
not the content just everything else, such as tables, fields, keys and so on...
thanks,
ark
Saqib Khan
use Sql Server's Import Export Wizard:)
ASKER
I just need a little asp script to automate the thing and not need to do it by hand. Basically from time to time I will need to add a table with few fields, and would like the addition to automatically propagate to other mdb files in a directory.
Hi ark2000,
Started something similar to this, but never finished it.
I found the best way to get all table fields and properties in one easy action was to open the table as an ado recordset then persist the recordset as XML. This can be done as a stream so no disk writes are required. I expect that once you have valid xml that you could execute most any sql action using the xml data and properties.
Heres the question that prompted my investigation earlier this year:
https://www.experts-exchange.com/questions/20759169/Running-a-macro-or-such-to-execute-TransferText-from-ADO.html
It is in vba syntax but can be easilly converted to vbscript.
Alan :)
Started something similar to this, but never finished it.
I found the best way to get all table fields and properties in one easy action was to open the table as an ado recordset then persist the recordset as XML. This can be done as a stream so no disk writes are required. I expect that once you have valid xml that you could execute most any sql action using the xml data and properties.
Heres the question that prompted my investigation earlier this year:
https://www.experts-exchange.com/questions/20759169/Running-a-macro-or-such-to-execute-TransferText-from-ADO.html
It is in vba syntax but can be easilly converted to vbscript.
Alan :)
Hi ark2000,
Heres a simple method to syncronise tables, you will need to give IUser account modify permissions on the destination db.
If table being syncronized is in a relationship with another table you will need to programaticlly remove the relationship first then establish it agin after synchronization.
Have ttested this locally no problems.
<%@ Language=VBScript %>
<%
Dim conn, conn2, sConnect, sDataPath, sql
set conn=Server.CreateObject("
set conn2=Server.CreateObject(
' open source connection
sDataPath = server.mappath("BackEnd.md
sConnect=adoConnectJet40(s
conn.Open sConnect
' open destination connection and drop existing table
sDataPath = server.mappath("BackEnd2.m
sConnect=adoConnectJet40(s
conn2.Open sConnect
sql = "DROP TABLE tbl_Customers "
conn2.Execute sql
conn2.Close
' Transfer source table and contents to destination
sql="SELECT tbl_Customers.* INTO tbl_Customers IN '" & sDataPath & "' FROM tbl_Customers"
conn.Execute sql
conn.close
Response.Write("done")
%>
<%
Public Function adoConnectJet40(psDataPath
' returns Jet 4.0 ADO connect string:
' "Provider=Microsoft.Jet.OL
' ;Data Source=C:\xxx\$OzWeb.mdb
' ;Jet OLEDB:Database Password=xxx"
Dim sProvider, sDataSource, sDBPassword
sProvider = "Provider=Microsoft.Jet.OL
sDataSource = ";Data Source=" & psDataPath
If psFilePassword = "" Then
sDBPassword = ""
Else
sDBPassword = ";Jet OLEDB:Database Password=" & psFilePassword
End If
adoConnectJet40 = sProvider & sDataSource & sDBPassword
End Function
%>
Alan :)
Heres a simple method to syncronise tables, you will need to give IUser account modify permissions on the destination db.
If table being syncronized is in a relationship with another table you will need to programaticlly remove the relationship first then establish it agin after synchronization.
Have ttested this locally no problems.
<%@ Language=VBScript %>
<%
Dim conn, conn2, sConnect, sDataPath, sql
set conn=Server.CreateObject("
set conn2=Server.CreateObject(
' open source connection
sDataPath = server.mappath("BackEnd.md
sConnect=adoConnectJet40(s
conn.Open sConnect
' open destination connection and drop existing table
sDataPath = server.mappath("BackEnd2.m
sConnect=adoConnectJet40(s
conn2.Open sConnect
sql = "DROP TABLE tbl_Customers "
conn2.Execute sql
conn2.Close
' Transfer source table and contents to destination
sql="SELECT tbl_Customers.* INTO tbl_Customers IN '" & sDataPath & "' FROM tbl_Customers"
conn.Execute sql
conn.close
Response.Write("done")
%>
<%
Public Function adoConnectJet40(psDataPath
' returns Jet 4.0 ADO connect string:
' "Provider=Microsoft.Jet.OL
' ;Data Source=C:\xxx\$OzWeb.mdb
' ;Jet OLEDB:Database Password=xxx"
Dim sProvider, sDataSource, sDBPassword
sProvider = "Provider=Microsoft.Jet.OL
sDataSource = ";Data Source=" & psDataPath
If psFilePassword = "" Then
sDBPassword = ""
Else
sDBPassword = ";Jet OLEDB:Database Password=" & psFilePassword
End If
adoConnectJet40 = sProvider & sDataSource & sDBPassword
End Function
%>
Alan :)
ASKER
ok, we can't drop the destination table, and we don't need to duplicate content, the content is different in both databases only the structure needs to be duplicated...
ASKER
also, we can't specify tables, the script needs to get the tables names and fields one by one.
Wouldn't something like getting sql from the source database and executing it on target work?
Wouldn't something like getting sql from the source database and executing it on target work?
Hi ark2000,
Merry Christmas mate.
The only thing I can think of is to use ADOX to interrogate the tables collection of the source catalog and apply the properties, names, types and sizes to the ADOX catalog for the destination db.
Have you used ADOX before?
Alan :)
Merry Christmas mate.
The only thing I can think of is to use ADOX to interrogate the tables collection of the source catalog and apply the properties, names, types and sizes to the ADOX catalog for the destination db.
Have you used ADOX before?
Alan :)
ASKER
nope
Merry Christmas =)
Merry Christmas =)
I'll see what I can dig up.
We are going to need one of these to begin with:
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
Can you see if your web is happy with this META TAG, I'll try to find some code to expose the catalog.
Just stick it in the head section of an ASP page and see if it complains.
<%@ Language=VBScript %>
<HTML>
<HEAD><Title>Retrieve info about a column from an Access DB via ADOX</Title>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
<!-- metadata type="typelib" name="ADO Type Library" uuid="00000206-0000-0010-8
<!-- metadata type="typelib" name="Microsoft Scripting Runtime" uuid="420B2830-E718-11CF-8
</HEAD>
<Body><P>Ok so far!</P></Body></html>
Alan :)
We are going to need one of these to begin with:
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
Can you see if your web is happy with this META TAG, I'll try to find some code to expose the catalog.
Just stick it in the head section of an ASP page and see if it complains.
<%@ Language=VBScript %>
<HTML>
<HEAD><Title>Retrieve info about a column from an Access DB via ADOX</Title>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
<!-- metadata type="typelib" name="ADO Type Library" uuid="00000206-0000-0010-8
<!-- metadata type="typelib" name="Microsoft Scripting Runtime" uuid="420B2830-E718-11CF-8
</HEAD>
<Body><P>Ok so far!</P></Body></html>
Alan :)
ASKER
yes, works fine
Hi ark2000,
The following code exposes all the tables and all the columns for each non SYS table and all the properties for each column in the source ADOX catalog. Phew!
I have leave this for a little while now and do the Christmas thing.
<%@ Language=VBScript %>
<HTML>
<HEAD><Title>Retrieve info about a column from an Access DB via ADOX</Title>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
<!-- metadata type="typelib" name="Microsoft Scripting Runtime" uuid="420B2830-E718-11CF-8
</HEAD>
<BODY>
<P>OK so far</P>
<%
Dim cat, conn, conn2, sConnect, sDataPath, sql
set conn=Server.CreateObject("
set conn2=Server.CreateObject(
' open source connection
sDataPath = server.mappath("BackEnd.md
sConnect=adoConnectJet40(s
conn.Open sConnect
' Open the catalog
Set cat = Server.CreateObject("ADOX.
Set cat.ActiveConnection = conn
dim j, i, k, tblCount, colCount, prpCount
tblCount = cat.Tables.Count
'print table names
i = 0
Do While i < tblCount
if instr(1,cat.Tables(i).Name
Response.Write(cat.Tables(
colCount = cat.Tables(i).Columns.Coun
j = 0
do while j < colCount
Response.Write("-- " & cat.Tables(i).Columns(j).N
prpCount = cat.Tables(i).Columns(j).P
k = 0
do while k < prpCount
Response.write("---- " & cat.Tables(i).Columns(j).P
k = k + 1
Loop
j= j + 1
Loop
end if
i = i + 1
Loop
set cat = nothing
conn.close
Response.Write("Phil says it is done")
%>
<%
Public Function adoConnectJet40(psDataPath
' returns Jet 4.0 ADO connect string:
' "Provider=Microsoft.Jet.OL
' ;Data Source=C:\xxx\$OzWeb.mdb
' ;Jet OLEDB:Database Password=xxx"
Dim sProvider, sDataSource, sDBPassword
sProvider = "Provider=Microsoft.Jet.OL
sDataSource = ";Data Source=" & psDataPath
If psFilePassword = "" Then
sDBPassword = ""
Else
sDBPassword = ";Jet OLEDB:Database Password=" & psFilePassword
End If
adoConnectJet40 = sProvider & sDataSource & sDBPassword
End Function
%>
</BODY>
</HTML>
Alan :)
The following code exposes all the tables and all the columns for each non SYS table and all the properties for each column in the source ADOX catalog. Phew!
I have leave this for a little while now and do the Christmas thing.
<%@ Language=VBScript %>
<HTML>
<HEAD><Title>Retrieve info about a column from an Access DB via ADOX</Title>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
<!-- metadata type="typelib" name="Microsoft Scripting Runtime" uuid="420B2830-E718-11CF-8
</HEAD>
<BODY>
<P>OK so far</P>
<%
Dim cat, conn, conn2, sConnect, sDataPath, sql
set conn=Server.CreateObject("
set conn2=Server.CreateObject(
' open source connection
sDataPath = server.mappath("BackEnd.md
sConnect=adoConnectJet40(s
conn.Open sConnect
' Open the catalog
Set cat = Server.CreateObject("ADOX.
Set cat.ActiveConnection = conn
dim j, i, k, tblCount, colCount, prpCount
tblCount = cat.Tables.Count
'print table names
i = 0
Do While i < tblCount
if instr(1,cat.Tables(i).Name
Response.Write(cat.Tables(
colCount = cat.Tables(i).Columns.Coun
j = 0
do while j < colCount
Response.Write("-- " & cat.Tables(i).Columns(j).N
prpCount = cat.Tables(i).Columns(j).P
k = 0
do while k < prpCount
Response.write("---- " & cat.Tables(i).Columns(j).P
k = k + 1
Loop
j= j + 1
Loop
end if
i = i + 1
Loop
set cat = nothing
conn.close
Response.Write("Phil says it is done")
%>
<%
Public Function adoConnectJet40(psDataPath
' returns Jet 4.0 ADO connect string:
' "Provider=Microsoft.Jet.OL
' ;Data Source=C:\xxx\$OzWeb.mdb
' ;Jet OLEDB:Database Password=xxx"
Dim sProvider, sDataSource, sDBPassword
sProvider = "Provider=Microsoft.Jet.OL
sDataSource = ";Data Source=" & psDataPath
If psFilePassword = "" Then
sDBPassword = ""
Else
sDBPassword = ";Jet OLEDB:Database Password=" & psFilePassword
End If
adoConnectJet40 = sProvider & sDataSource & sDBPassword
End Function
%>
</BODY>
</HTML>
Alan :)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi Alan, no way, SQL is black magic to me...
it's a shame, as my brother is a SQL guru but he won't help me... I think he's making close to $200 - $300 an hour consulting.
anyway, if you can get this thing all the way to the end, where it would automatically update a target daabase to have identical structure as the original, that should do it... I'll be extremely greatfull =)
it's a shame, as my brother is a SQL guru but he won't help me... I think he's making close to $200 - $300 an hour consulting.
anyway, if you can get this thing all the way to the end, where it would automatically update a target daabase to have identical structure as the original, that should do it... I'll be extremely greatfull =)
Hi ark2000,
Have you tested what I have given you so far, about 6 hours work so far.
Not much point going on if what we have done so far doesnt work on your machine.
To test:
1... Change a table name in the destination database then run script.
Should return output like this:
=========================
Comparing Catalogs
=========================
Source: c:\inetpub\wwwroot\Testing
Destination: c:\inetpub\wwwroot\Testing
=========================
Catalogs differ in table structure
-- tbl_Customers does not exist in: c:\inetpub\wwwroot\Testing
=========================
*** Dont forget to rename the table back to original name before doing next test
2... Change a column name in destination db and run script
should return output like this:
=========================
Comparing Catalogs
=========================
Source: c:\inetpub\wwwroot\Testing
Destination: c:\inetpub\wwwroot\Testing
=========================
Catalogs differ in column structure
-- tbl_Customers!CusOtherName
=========================
Note ***
I have not parameterized the database names and code currently assumes that they exist in same dir as ASP page
Alan :)
ps This is a huge task to achieve, one that I have started on numerous occasions but never got around to finishing.
So far so good. :)
Have you tested what I have given you so far, about 6 hours work so far.
Not much point going on if what we have done so far doesnt work on your machine.
To test:
1... Change a table name in the destination database then run script.
Should return output like this:
=========================
Comparing Catalogs
=========================
Source: c:\inetpub\wwwroot\Testing
Destination: c:\inetpub\wwwroot\Testing
=========================
Catalogs differ in table structure
-- tbl_Customers does not exist in: c:\inetpub\wwwroot\Testing
=========================
*** Dont forget to rename the table back to original name before doing next test
2... Change a column name in destination db and run script
should return output like this:
=========================
Comparing Catalogs
=========================
Source: c:\inetpub\wwwroot\Testing
Destination: c:\inetpub\wwwroot\Testing
=========================
Catalogs differ in column structure
-- tbl_Customers!CusOtherName
=========================
Note ***
I have not parameterized the database names and code currently assumes that they exist in same dir as ASP page
Alan :)
ps This is a huge task to achieve, one that I have started on numerous occasions but never got around to finishing.
So far so good. :)
ASKER
Hi Alan,
Unfortunately my server isn't working for the whole day, I keep trying to get the tech ppl at the host but there seems to be no one there, I can't test the script, I get Service Unavailable message no matter what page I'm trying to access...
thanks,
ark
Unfortunately my server isn't working for the whole day, I keep trying to get the tech ppl at the host but there seems to be no one there, I can't test the script, I get Service Unavailable message no matter what page I'm trying to access...
thanks,
ark
Hi Ark,
You can test it using localhost if you have IIS installed, best place to develop everything anyway before deploying to web.
IIS is not a default install option when installing windows 2k pro or xp pro, you must choose it form add/remove programs - windows components.
Might get a chance to do a bit more of this tonight, not really in the zone at the moment, installing stuff and building new system up.
Hope you had a cool christmas!
Alan :)
You can test it using localhost if you have IIS installed, best place to develop everything anyway before deploying to web.
IIS is not a default install option when installing windows 2k pro or xp pro, you must choose it form add/remove programs - windows components.
Might get a chance to do a bit more of this tonight, not really in the zone at the moment, installing stuff and building new system up.
Hope you had a cool christmas!
Alan :)
ASKER
Hi Alan,
I hope you got a dual processor setup for the new system =) 64bit?
I don't have the IIS installed.
ark
I hope you got a dual processor setup for the new system =) 64bit?
I don't have the IIS installed.
ark
Hi ark,
The following code will compare tables and colums in two Jet mdb's
If destination table does not exist will create table and columns in destination mdb
If destination table does exist but column does not exist will create column in destination table
If destination mdb doesnt exist, you are on your own buddy! LOL
Properties cannot be modified they are readonly except at time of creation, so if a column exists but has a different property (eg size, type) this can only be fixed by creating a new column.
Hope you are happy with this code, I am, but I have hade enough of this now and want to move on to something else.
Good luck with your app ark!
ps.. Dont forget to give IUSER modify permissions on destination mdb.
Oh code outputs a report something like this:
=========================
Comparing Catalogs
=========================
Source: c:\inetpub\wwwroot\Testing
Destination: c:\inetpub\wwwroot\Testing
=========================
Checking table structure
-- tbl_CustomersNew4 does not exist in: c:\inetpub\wwwroot\Testing
F I X E D tbl_CustomersNew4!CusDate Created
F I X E D tbl_CustomersNew4!CusDOB Created
F I X E D tbl_CustomersNew4!CusFName
F I X E D tbl_CustomersNew4!CusID Created
F I X E D tbl_CustomersNew4!CusLName
F I X E D tbl_CustomersNew4!CusNotes
F I X E D tbl_CustomersNew4!CusPhone
F I X E D tbl_CustomersNew4!CusPostC
F I X E D tbl_CustomersNew4!CusState
F I X E D tbl_CustomersNew4!CusStree
F I X E D tbl_CustomersNew4!CusSubur
F I X E D tbl_CustomersNew4!CusUndes
F I X E D tbl_CustomersNew4!NewCusOt
=========================-
Checking column structure in tbl_Loans
-- tbl_Loans!CusID exists in: tbl_Loans
-- tbl_Loans!LoanCurrent exists in: tbl_Loans
-- tbl_Loans!LoanDate exists in: tbl_Loans
-- tbl_Loans!LoanDateDropped exists in: tbl_Loans
-- tbl_Loans!LoanDropped exists in: tbl_Loans
-- tbl_Loans!LoanExtensionRat
-- tbl_Loans!LoanExtentionCha
-- tbl_Loans!LoanID exists in: tbl_Loans
-- tbl_Loans!LoanNextDuePayme
-- tbl_Loans!LoanPrincipleLoa
-- tbl_Loans!LoanRedeemed exists in: tbl_Loans
-- tbl_Loans!LoanSuspended exists in: tbl_Loans
-- tbl_Loans!New2ContractNumb
-- tbl_Loans!SalesPersonID exists in: tbl_Loans
-- tbl_Payments exists in: c:\inetpub\wwwroot\Testing
Checking column structure in tbl_Payments
-- tbl_Payments!ExtendTotal exists in: tbl_Payments
-- tbl_Payments!Interest exists in: tbl_Payments
-- tbl_Payments!Interest_ext exists in: tbl_Payments
-- tbl_Payments!InterestPaid exists in: tbl_Payments
-- tbl_Payments!InterestRate exists in: tbl_Payments
-- tbl_Payments!InterestRate_
-- tbl_Payments!LastOutstandi
-- tbl_Payments!LastPayment exists in: tbl_Payments
-- tbl_Payments!LateFees exists in: tbl_Payments
-- tbl_Payments!LoanID exists in: tbl_Payments
-- tbl_Payments!LoanPrinciple
-- tbl_Payments!MonthlyCharge
-- tbl_Payments!MonthlyCharge
-- tbl_Payments!NextDueDate exists in: tbl_Payments
-- tbl_Payments!Outstanding exists in: tbl_Payments
-- tbl_Payments!PaymentAmount
-- tbl_Payments!PaymentDate exists in: tbl_Payments
-- tbl_Payments!PaymentID exists in: tbl_Payments
-- tbl_Payments!ReceiptNum exists in: tbl_Payments
-- tbl_Payments!RedeemTotal exists in: tbl_Payments
-- tbl_Payments!Shortfall exists in: tbl_Payments
=========================
'=========================
' BEGIN CODE
'=========================
<%@ Language=VBScript %>
<HTML>
<HEAD><Title>Retrieve info about a column from an Access DB via ADOX</Title>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
<!-- metadata type="typelib" name="Microsoft Scripting Runtime" uuid="420B2830-E718-11CF-8
</HEAD>
<BODY>
<%
Dim cat, conn, sConnect, sDataPath, connOK
Dim cat2, conn2, sConnect2, sDataPath2, conn2OK
Dim tblNew, colNew, prpNew
Dim sCompMsg, sRetMsg
Set cat = Nothing
Set conn = Nothing
Set cat2 = Nothing
Set conn2 = Nothing
Set conn = Server.CreateObject("ADODB
Set conn2 = Server.CreateObject("ADODB
Set cat = Server.CreateObject("ADOX.
Set cat2 = Server.CreateObject("ADOX.
sCompMsg = "=========================
sCompMsg = sCompMsg & "Comparing Catalogs" & "<br />"
sCompMsg = sCompMsg & "=========================
On Error Resume Next
' open source connection
sDataPath = Server.MapPath("BackEnd.md
sCompMsg = sCompMsg & "Source: " & sDataPath
sConnect = adoConnectJet40(sDataPath,
conn.Open sConnect
If conn.State = 1 Then
connOK = " Connected"
Else
connOK = " Not Connected"
End If
sCompMsg = sCompMsg & connOK & "<br />"
' Open the source catalog
Set cat.ActiveConnection = conn
' open destination connection
sDataPath2 = Server.MapPath("BackEnd2.m
sCompMsg = sCompMsg & "Destination: " & sDataPath2
sConnect2 = adoConnectJet40(sDataPath2
conn2.Open sConnect2
If conn2.State = 1 Then
conn2OK = " Connected"
Else
conn2OK = " Not Connected"
End If
sCompMsg = sCompMsg & conn2OK & "<br />"
If connOK = " Connected" And conn2OK = " Connected" Then
' Open the destination catalog
Set cat2.ActiveConnection = conn2
Dim j, i, k, tblCount, colCount, prpCount, tblName, col, prp
tblCount = cat.Tables.Count
'check table structure
sCompMsg = sCompMsg & "=========================
sCompMsg = sCompMsg & "Checking table structure" & "<br />"
i = 0
Do While i < tblCount
If InStr(1, cat.Tables(i).Name, "MSys", 1) = 0 Then
'tblNew.Name = ""
tblName = cat.Tables(i).Name
If Not compareTable(conn2, cat2, tblName, sRetMsg) Then
sCompMsg = sCompMsg & sRetMsg & sDataPath2 & "<br />"
Set tblNew = nothing
Set tblNew = Server.CreateObject("ADOX.
tblNew.Name = cat.Tables(i).Name
colCount = cat.Tables(i).Columns.Coun
j = 0
Do While j < colCount
Set colNew = Nothing
Set colNew = Server.CreateObject("ADOX.
colNew.Name = cat.Tables(i).Columns(j).N
colNew.Type = cat.Tables(i).Columns(j).T
colNew.DefinedSize = cat.Tables(i).Columns(j).D
colNew.Attributes = cat.Tables(i).Columns(j).A
tblNew.Columns.Append colNew.Name, colNew.Type, colNew.DefinedSize
sCompMsg = sCompMsg & " F I X E D " & tblNew.Name & "!" & colNew.Name & " Created " & "<br />"
j = j + 1
Loop
cat2.Tables.Append tblNew
sCompMsg = sCompMsg & "=========================
Else
sCompMsg = sCompMsg & sRetMsg & sDataPath2 & "<br />"
sCompMsg = sCompMsg & "Checking column structure in " & tblName & "<br />"
colCount = cat.Tables(i).Columns.Coun
j = 0
Do While j < colCount
col = cat.Tables(i).Columns(j).N
If Not compareCol(conn2, cat2, tblName, col, sRetMsg) Then
Set colNew = Nothing
Set colNew = Server.CreateObject("ADOX.
colNew.Name = cat.Tables(i).Columns(j).N
colNew.Name = cat.Tables(i).Columns(j).N
colNew.Type = cat.Tables(i).Columns(j).T
colNew.DefinedSize = cat.Tables(i).Columns(j).D
colNew.Attributes = cat.Tables(i).Columns(j).A
cat2.Tables(tblName).Colum
sCompMsg = sCompMsg & " F I X E D " & tblNew.Name & "!" & colNew.Name & " Created " & "<br />"
Else
sCompMsg = sCompMsg & sRetMsg & tblName & "<br />"
prpCount = cat.Tables(i).Columns(j).P
k = 0
Do While k < prpCount
prp = cat.Tables(i).Columns(j).P
If Not comparePrp(conn2, cat2, tblName, col, prp, sRetMsg) Then
sCompMsg = sCompMsg & "=========================
sCompMsg = sCompMsg & "Catalogs differ in column properties structure" & "<br />"
sCompMsg = sCompMsg & sRetMsg & sDataPath2 & "<br />"
sCompMsg = sCompMsg & "=========================
Else
End If
k = k + 1
Loop
End If
j = j + 1
Loop
End If
End If
i = i + 1
Loop
sCompMsg = sCompMsg & "=========================
Else
Debug.Print sCompMsg
'Response.End
End If 'connOK = " Connected" and conn2OK = " Connected"
Set cat = Nothing
conn.Close
Set cat2 = Nothing
conn2.Close
Response.Write(sCompMsg)
%>
<%
Public Function comparePrp(cn, xCat, tblName, colName, prpName, sRetMsg)
comparePrp = false
sRetMsg = "-- " & tblName & "!" & colName & "." & prpName & " does not exist in: "
dim i, prpCount
prpCount = xCat.Tables(tblName).Colum
'compare table names
i = 0
Do While i < prpCount
if xCat.Tables(tblName).Colum
comparePrp = true
exit function
end if
i = i + 1
loop
' if code gets this far no match found
comparePrp = false
End Function
Public Function compareCol(cn, xCat, tblName, colName, sRetMsg)
compareCol = false
sRetMsg = "-- " & tblName & "!" & colName & " does not exist in: "
'on error resume next
dim i, colCount
colCount = xCat.Tables(tblName).Colum
'compare table names
i = 0
Do While i < colCount
if xCat.Tables(tblName).Colum
compareCol = true
sRetMsg = "-- " & tblName & "!" & colName & " exists in: "
'set cat2 = nothing
'conn2.close
exit function
end if
i = i + 1
loop
' if code gets this far no match found
compareCol = false
End Function
Public Function compareTable(cn, xCat, tblName, sRetMsg)
compareTable = false
sRetMsg = "-- " & tblName & " does not exist in: "
'Response.end
on error resume next
dim i, tblCount
tblCount = xCat.Tables.Count
'compare table names
i = 0
Do While i < tblCount
if xCat.Tables(i).Name = tblName then
compareTable = true
sRetMsg = "-- " & tblName & " exists in: "
exit function
else
end if
i = i + 1
loop
' if code gets this far no match found
compareTable = false
End Function
Public Function adoConnectJet40(psDataPath
' returns Jet 4.0 ADO connect string:
' "Provider=Microsoft.Jet.OL
' ;Data Source=C:\xxx\$OzWeb.mdb
' ;Jet OLEDB:Database Password=xxx"
Dim sProvider, sDataSource, sDBPassword
sProvider = "Provider=Microsoft.Jet.OL
sDataSource = ";Data Source=" & psDataPath
If psFilePassword = "" Then
sDBPassword = ""
Else
sDBPassword = ";Jet OLEDB:Database Password=" & psFilePassword
End If
adoConnectJet40 = sProvider & sDataSource & sDBPassword
End Function
%>
</BODY>
</HTML>
The following code will compare tables and colums in two Jet mdb's
If destination table does not exist will create table and columns in destination mdb
If destination table does exist but column does not exist will create column in destination table
If destination mdb doesnt exist, you are on your own buddy! LOL
Properties cannot be modified they are readonly except at time of creation, so if a column exists but has a different property (eg size, type) this can only be fixed by creating a new column.
Hope you are happy with this code, I am, but I have hade enough of this now and want to move on to something else.
Good luck with your app ark!
ps.. Dont forget to give IUSER modify permissions on destination mdb.
Oh code outputs a report something like this:
=========================
Comparing Catalogs
=========================
Source: c:\inetpub\wwwroot\Testing
Destination: c:\inetpub\wwwroot\Testing
=========================
Checking table structure
-- tbl_CustomersNew4 does not exist in: c:\inetpub\wwwroot\Testing
F I X E D tbl_CustomersNew4!CusDate Created
F I X E D tbl_CustomersNew4!CusDOB Created
F I X E D tbl_CustomersNew4!CusFName
F I X E D tbl_CustomersNew4!CusID Created
F I X E D tbl_CustomersNew4!CusLName
F I X E D tbl_CustomersNew4!CusNotes
F I X E D tbl_CustomersNew4!CusPhone
F I X E D tbl_CustomersNew4!CusPostC
F I X E D tbl_CustomersNew4!CusState
F I X E D tbl_CustomersNew4!CusStree
F I X E D tbl_CustomersNew4!CusSubur
F I X E D tbl_CustomersNew4!CusUndes
F I X E D tbl_CustomersNew4!NewCusOt
=========================-
Checking column structure in tbl_Loans
-- tbl_Loans!CusID exists in: tbl_Loans
-- tbl_Loans!LoanCurrent exists in: tbl_Loans
-- tbl_Loans!LoanDate exists in: tbl_Loans
-- tbl_Loans!LoanDateDropped exists in: tbl_Loans
-- tbl_Loans!LoanDropped exists in: tbl_Loans
-- tbl_Loans!LoanExtensionRat
-- tbl_Loans!LoanExtentionCha
-- tbl_Loans!LoanID exists in: tbl_Loans
-- tbl_Loans!LoanNextDuePayme
-- tbl_Loans!LoanPrincipleLoa
-- tbl_Loans!LoanRedeemed exists in: tbl_Loans
-- tbl_Loans!LoanSuspended exists in: tbl_Loans
-- tbl_Loans!New2ContractNumb
-- tbl_Loans!SalesPersonID exists in: tbl_Loans
-- tbl_Payments exists in: c:\inetpub\wwwroot\Testing
Checking column structure in tbl_Payments
-- tbl_Payments!ExtendTotal exists in: tbl_Payments
-- tbl_Payments!Interest exists in: tbl_Payments
-- tbl_Payments!Interest_ext exists in: tbl_Payments
-- tbl_Payments!InterestPaid exists in: tbl_Payments
-- tbl_Payments!InterestRate exists in: tbl_Payments
-- tbl_Payments!InterestRate_
-- tbl_Payments!LastOutstandi
-- tbl_Payments!LastPayment exists in: tbl_Payments
-- tbl_Payments!LateFees exists in: tbl_Payments
-- tbl_Payments!LoanID exists in: tbl_Payments
-- tbl_Payments!LoanPrinciple
-- tbl_Payments!MonthlyCharge
-- tbl_Payments!MonthlyCharge
-- tbl_Payments!NextDueDate exists in: tbl_Payments
-- tbl_Payments!Outstanding exists in: tbl_Payments
-- tbl_Payments!PaymentAmount
-- tbl_Payments!PaymentDate exists in: tbl_Payments
-- tbl_Payments!PaymentID exists in: tbl_Payments
-- tbl_Payments!ReceiptNum exists in: tbl_Payments
-- tbl_Payments!RedeemTotal exists in: tbl_Payments
-- tbl_Payments!Shortfall exists in: tbl_Payments
=========================
'=========================
' BEGIN CODE
'=========================
<%@ Language=VBScript %>
<HTML>
<HEAD><Title>Retrieve info about a column from an Access DB via ADOX</Title>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<!-- metadata type="typelib" name="Microsoft ADO Ext. *.* for DDL and Security" uuid="00000600-0000-0010-8
<!-- metadata type="typelib" name="Microsoft Scripting Runtime" uuid="420B2830-E718-11CF-8
</HEAD>
<BODY>
<%
Dim cat, conn, sConnect, sDataPath, connOK
Dim cat2, conn2, sConnect2, sDataPath2, conn2OK
Dim tblNew, colNew, prpNew
Dim sCompMsg, sRetMsg
Set cat = Nothing
Set conn = Nothing
Set cat2 = Nothing
Set conn2 = Nothing
Set conn = Server.CreateObject("ADODB
Set conn2 = Server.CreateObject("ADODB
Set cat = Server.CreateObject("ADOX.
Set cat2 = Server.CreateObject("ADOX.
sCompMsg = "=========================
sCompMsg = sCompMsg & "Comparing Catalogs" & "<br />"
sCompMsg = sCompMsg & "=========================
On Error Resume Next
' open source connection
sDataPath = Server.MapPath("BackEnd.md
sCompMsg = sCompMsg & "Source: " & sDataPath
sConnect = adoConnectJet40(sDataPath,
conn.Open sConnect
If conn.State = 1 Then
connOK = " Connected"
Else
connOK = " Not Connected"
End If
sCompMsg = sCompMsg & connOK & "<br />"
' Open the source catalog
Set cat.ActiveConnection = conn
' open destination connection
sDataPath2 = Server.MapPath("BackEnd2.m
sCompMsg = sCompMsg & "Destination: " & sDataPath2
sConnect2 = adoConnectJet40(sDataPath2
conn2.Open sConnect2
If conn2.State = 1 Then
conn2OK = " Connected"
Else
conn2OK = " Not Connected"
End If
sCompMsg = sCompMsg & conn2OK & "<br />"
If connOK = " Connected" And conn2OK = " Connected" Then
' Open the destination catalog
Set cat2.ActiveConnection = conn2
Dim j, i, k, tblCount, colCount, prpCount, tblName, col, prp
tblCount = cat.Tables.Count
'check table structure
sCompMsg = sCompMsg & "=========================
sCompMsg = sCompMsg & "Checking table structure" & "<br />"
i = 0
Do While i < tblCount
If InStr(1, cat.Tables(i).Name, "MSys", 1) = 0 Then
'tblNew.Name = ""
tblName = cat.Tables(i).Name
If Not compareTable(conn2, cat2, tblName, sRetMsg) Then
sCompMsg = sCompMsg & sRetMsg & sDataPath2 & "<br />"
Set tblNew = nothing
Set tblNew = Server.CreateObject("ADOX.
tblNew.Name = cat.Tables(i).Name
colCount = cat.Tables(i).Columns.Coun
j = 0
Do While j < colCount
Set colNew = Nothing
Set colNew = Server.CreateObject("ADOX.
colNew.Name = cat.Tables(i).Columns(j).N
colNew.Type = cat.Tables(i).Columns(j).T
colNew.DefinedSize = cat.Tables(i).Columns(j).D
colNew.Attributes = cat.Tables(i).Columns(j).A
tblNew.Columns.Append colNew.Name, colNew.Type, colNew.DefinedSize
sCompMsg = sCompMsg & " F I X E D " & tblNew.Name & "!" & colNew.Name & " Created " & "<br />"
j = j + 1
Loop
cat2.Tables.Append tblNew
sCompMsg = sCompMsg & "=========================
Else
sCompMsg = sCompMsg & sRetMsg & sDataPath2 & "<br />"
sCompMsg = sCompMsg & "Checking column structure in " & tblName & "<br />"
colCount = cat.Tables(i).Columns.Coun
j = 0
Do While j < colCount
col = cat.Tables(i).Columns(j).N
If Not compareCol(conn2, cat2, tblName, col, sRetMsg) Then
Set colNew = Nothing
Set colNew = Server.CreateObject("ADOX.
colNew.Name = cat.Tables(i).Columns(j).N
colNew.Name = cat.Tables(i).Columns(j).N
colNew.Type = cat.Tables(i).Columns(j).T
colNew.DefinedSize = cat.Tables(i).Columns(j).D
colNew.Attributes = cat.Tables(i).Columns(j).A
cat2.Tables(tblName).Colum
sCompMsg = sCompMsg & " F I X E D " & tblNew.Name & "!" & colNew.Name & " Created " & "<br />"
Else
sCompMsg = sCompMsg & sRetMsg & tblName & "<br />"
prpCount = cat.Tables(i).Columns(j).P
k = 0
Do While k < prpCount
prp = cat.Tables(i).Columns(j).P
If Not comparePrp(conn2, cat2, tblName, col, prp, sRetMsg) Then
sCompMsg = sCompMsg & "=========================
sCompMsg = sCompMsg & "Catalogs differ in column properties structure" & "<br />"
sCompMsg = sCompMsg & sRetMsg & sDataPath2 & "<br />"
sCompMsg = sCompMsg & "=========================
Else
End If
k = k + 1
Loop
End If
j = j + 1
Loop
End If
End If
i = i + 1
Loop
sCompMsg = sCompMsg & "=========================
Else
Debug.Print sCompMsg
'Response.End
End If 'connOK = " Connected" and conn2OK = " Connected"
Set cat = Nothing
conn.Close
Set cat2 = Nothing
conn2.Close
Response.Write(sCompMsg)
%>
<%
Public Function comparePrp(cn, xCat, tblName, colName, prpName, sRetMsg)
comparePrp = false
sRetMsg = "-- " & tblName & "!" & colName & "." & prpName & " does not exist in: "
dim i, prpCount
prpCount = xCat.Tables(tblName).Colum
'compare table names
i = 0
Do While i < prpCount
if xCat.Tables(tblName).Colum
comparePrp = true
exit function
end if
i = i + 1
loop
' if code gets this far no match found
comparePrp = false
End Function
Public Function compareCol(cn, xCat, tblName, colName, sRetMsg)
compareCol = false
sRetMsg = "-- " & tblName & "!" & colName & " does not exist in: "
'on error resume next
dim i, colCount
colCount = xCat.Tables(tblName).Colum
'compare table names
i = 0
Do While i < colCount
if xCat.Tables(tblName).Colum
compareCol = true
sRetMsg = "-- " & tblName & "!" & colName & " exists in: "
'set cat2 = nothing
'conn2.close
exit function
end if
i = i + 1
loop
' if code gets this far no match found
compareCol = false
End Function
Public Function compareTable(cn, xCat, tblName, sRetMsg)
compareTable = false
sRetMsg = "-- " & tblName & " does not exist in: "
'Response.end
on error resume next
dim i, tblCount
tblCount = xCat.Tables.Count
'compare table names
i = 0
Do While i < tblCount
if xCat.Tables(i).Name = tblName then
compareTable = true
sRetMsg = "-- " & tblName & " exists in: "
exit function
else
end if
i = i + 1
loop
' if code gets this far no match found
compareTable = false
End Function
Public Function adoConnectJet40(psDataPath
' returns Jet 4.0 ADO connect string:
' "Provider=Microsoft.Jet.OL
' ;Data Source=C:\xxx\$OzWeb.mdb
' ;Jet OLEDB:Database Password=xxx"
Dim sProvider, sDataSource, sDBPassword
sProvider = "Provider=Microsoft.Jet.OL
sDataSource = ";Data Source=" & psDataPath
If psFilePassword = "" Then
sDBPassword = ""
Else
sDBPassword = ";Jet OLEDB:Database Password=" & psFilePassword
End If
adoConnectJet40 = sProvider & sDataSource & sDBPassword
End Function
%>
</BODY>
</HTML>