Siehe auch:
Dieser VBScript Code konvertiert Access Datenbanken zu SQL Server Datenbanken via versa
Bitte kontaktieren Sie uns, falls Sie spezielle praktische Scripts brauchen, um Ihre Arbeit zu erleichtern.
<%@LANGUAGE="VBScript" %>
<%
''*********************************
'' Speichern Sie diese Datei als: convertdb.asp
''*********************************
Option Explicit
Server.ScriptTimeout = 3600
Response.Buffer = True
Response.Expires = 0
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H0001
Const adUseClient = 3
Const Jet4x = 5
Dim Browser
Dim BrowserType
Dim TextBoxSize
Dim TextAreaCols
Dim strError
Dim objFSO
Dim Catalog
Dim DbPathTo
Dim DBPathFrom
Dim TheColumn
Dim TxtArea
Dim Conn_1
Dim Conn_2
Dim Table
Dim TblName
Dim SQL
Dim strSQL
Dim RS_0
Dim FldName
Dim cType
Dim cSize
Dim RS_2
Dim strSQL1
Dim RS_1
Dim tbCount
Dim flCount
Dim rcCount
Dim FieldStr
Dim ValueStr
Dim varTemp
Dim RS_1FldNameName
Browser = Request.ServerVariables("HTTP_USER_AGENT")
If InStr(Browser, "MSIE") Then
BrowserType = "Microsoft"
TextBoxSize = 20
TextAreaCols = 120
Else
BrowserType = "Other"
TextBoxSize = 14
TextAreaCols = 65
End If
If Request("ServerAddress") <> "" And Request("SqlDbName") <> "" And Request("AccessDbName") <> "" And Request("DbPort") <> "" And Request("DbPassword") <> "" And Request("DbUsername") <> "" Then
On Error Resume Next
If Request("DbType") = "" Then
CreateNewMDB Server.MapPath(Request("AccessDbName") & ".mdb"), Jet4x
DbPathTo = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath(Request("AccessDbName") & ".mdb") & ";"
DBPathFrom = "DRIVER=SQL Server; SERVER=" & Request("ServerAddress") & "; DATABASE=" & Request("SqlDbName") & "; PORT=" & Request("DbPort") & "; UID=" & Request("DbUsername") & "; PASSWORD=" & Request("DbPassword") & ";"
TheColumn = " COLUMN"
Else
DBPathFrom = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath(Request("AccessDbName") & ".mdb") & ";"
DbPathTo = "DRIVER=SQL Server; SERVER=" & Request("ServerAddress") & "; DATABASE=" & Request("SqlDbName") & "; PORT=" & Request("DbPort") & "; UID=" & Request("DbUsername") & "; PASSWORD=" & Request("DbPassword") & ";"
TheColumn = ""
End If
TxtArea = vbcrlf & vbcrlf
Set Conn_1 = Server.CreateObject("ADODB.Connection")
Conn_1.Open DBPathFrom
TxtArea = TxtArea & "DBPathFrom = "" & DBPathFrom & """ & vbcrlf
TxtArea = TxtArea & "Set Conn_1 = Server.CreateObject("ADODB.Connection")" & vbcrlf
TxtArea = TxtArea & "Conn_1.Open DBPathFrom" & vbcrlf & vbcrlf
Set Conn_2 = Server.CreateObject("ADODB.Connection")
Conn_2.Open DbPathTo
TxtArea = TxtArea & "DbPathTo = "" & DbPathTo & """ & vbcrlf
TxtArea = TxtArea & "Set Conn_2 = Server.CreateObject("ADODB.Connection")" & vbcrlf
TxtArea = TxtArea & "Conn_2.Open DbPathTo" & vbcrlf & vbcrlf
If Err = 0 Then
Set Table = Conn_1.OpenSchema(20)
tbCount = 0
While Not Table.EOF
TblName = Table("Table_Name")
If UCase(Left(TblName, 4)) <> "MSYS" And UCase(Left(TblName, 3)) <> "SYS" And UCase(Left(TblName, 4)) <> "RTBL" And UCase(Left(TblName, 3)) <> "DTP" Then
On Error Resume Next
tbCount = tbCount + 1
If Request("DbType") = "" Then
SQL = "CREATE TABLE " & TblName & " (" & TblName & "ID Counter NOT NULL CONSTRAINT [pk" & TblName & "ID] PRIMARY KEY)"
Else
SQL = "CREATE TABLE " & TblName & " (" & TblName & "ID integer IDENTITY (1, 1) NOT NULL CONSTRAINT [pk" & TblName & "ID] PRIMARY KEY)"
End If
Conn_2.Execute(SQL)
TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
strSQL = "SELECT * FROM " & TblName
Set RS_0 = Conn_1.Execute(strSQL)
flCount = 0
For Each FldName In RS_0.Fields
flCount = flCount + 1
If FldName.attributes <> 16 Then
cType = GetTypeName(FldName.Type)
cSize = FldName.DefinedSize
If cType = "varchar" Or cType = "nvarchar" Then
cSize = " (" & cSize & ")"
Else
cSize = ""
End If
SQL = "ALTER TABLE " & TblName & " ADD" & TheColumn & " " & FldName.Name & " " & cType & cSize & " NULL"
Conn_2.Execute(SQL)
TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
Set RS_2 = Conn_1.openSchema(12)
Do While Not RS_2.EOF
If RS_2("Table_Name") = TblName Then
If RS_2("Column_Name") = FldName.Name Then
If (RS_2("Unique") = True) Then
SQL = "ALTER TABLE " & TblName & " ALTER COLUMN " & FldName.Name & " " & cType & cSize & " NULL CONSTRAINT [idx" & FldName.Name & "] UNIQUE"
Conn_2.Execute(SQL)
TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
End If
End If
End If
RS_2.MoveNext
Loop
RS_2.Close
Set RS_2 = Nothing
End If
Next
RS_0.Close
Set RS_0 = Nothing
If Request("TheValues") <> "" Then
On Error Resume Next
strSQL1 = "SELECT * FROM " & TblName & " ORDER BY " & TblName & "ID ASC"
Set RS_1 = Server.CreateObject("ADODB.Recordset")
RS_1.CursorLocation = adUseClient
RS_1.Open (strSQL1), Conn_1, adOpenForwardOnly, adLockReadOnly, adCmdText
rcCount = 0
If Not RS_1.EOF Then
Do Until RS_1.EOF
rcCount = rcCount + 1
FieldStr = " ("
ValueStr = " VALUES ("
For Each FldName In RS_1.Fields
If FldName.attributes <> 16 Then
cType = GetTypeName(FldName.Type)
If cType = "integer" Or cType = "smallint" Or cType = "double" Or cType = "bigint" Then
RS_1FldNameName = RS_1(FldName.Name)
If RS_1FldNameName <> "" Then
FieldStr = FieldStr & FldName.Name & ", "
ValueStr = ValueStr & RS_1FldNameName & ", "
Else
FieldStr = FieldStr & FldName.Name & ", "
ValueStr = ValueStr & "0, "
End If
Else
RS_1FldNameName = CheckString(RS_1(FldName.Name))
If cType = "bit" Or cType = "yesno" Then
If RS_1FldNameName = "True" Then
RS_1FldNameName = "1"
Else
RS_1FldNameName = "0"
End If
End If
If RS_1FldNameName <> "" Then
FieldStr = FieldStr & FldName.Name & ", "
ValueStr = ValueStr & "''" & RS_1FldNameName & "'', "
End If
End If
End If
Next
If Len(FieldStr) > 3 And Len(ValueStr) > 12 Then
FieldStr = Mid(FieldStr, 1, Len(FieldStr) - 2) & ")"
ValueStr = Mid(ValueStr, 1, Len(ValueStr) - 2) & ")"
strSQL = "INSERT INTO " & TblName & FieldStr & ValueStr
Conn_2.Execute(strSQL)
End If
RS_1.MoveNext
Loop
End If
RS_1.Close
Set RS_1 = Nothing
End If
End If
Table.MoveNext
Wend
Response.Write "<DIV ALIGN=""center""><BR><B><FONT COLOR=""#0000CC"">The Database has been converted successfully!</FONT></B></DIV>"
End If
Sub CreateNewMDB(FileName, Format)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(FileName) Then
Response.Write "<DIV ALIGN=""center""><BR><B><FONT COLOR=""#CC0000"">Database Already Exists.</FONT></B></DIV>" &vbcrlf
Set objFSO = Nothing
Exit Sub
End If
Set objFSO = Nothing
If Err Then
Exit Sub
Else
Set Catalog = Server.CreateObject("ADOX.Catalog")
Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & "Jet OLEDB:Engine Type=" & Format & ";Data Source=" & FileName
Set Catalog = Nothing
End If
End Sub
Function CheckString(varValue)
varTemp = varValue
On Error Resume Next
varTemp = Replace(varTemp, "''", "''")
varTemp = Replace(varTemp, """", """")
varTemp = Replace(varTemp, "%", chr(37))
varTemp = Trim(varTemp)
CheckString = varTemp
End Function
Private Function GetTypeName(ByVal sFieldType)
Select Case sFieldType
Case 0
GetTypeName = "Empty"
Case 16
GetTypeName = "tinyint"
Case 2
GetTypeName = "smallint"
Case 3
GetTypeName = "int"
Case 20
GetTypeName = "bigint"
Case 17
GetTypeName = "tinyint"
Case 18
GetTypeName = "smallint"
Case 19
GetTypeName = "int"
Case 21
GetTypeName = "bigint"
Case 4
GetTypeName = "real"
Case 5
GetTypeName = "float"
Case 6
GetTypeName = "money"
Case 14
GetTypeName = "decimal"
Case 131
GetTypeName = "numeric"
Case 11
GetTypeName = "bit"
Case 10
GetTypeName = "Error"
Case 132
GetTypeName = "UserDefined"
Case 12
GetTypeName = "variant"
Case 9
GetTypeName = "IDispatch"
Case 13
GetTypeName = "IUnknown"
Case 72
GetTypeName = "uniqueidentifier"
Case 7, 133, 134, 135
GetTypeName = "datetime"
Case 8
GetTypeName = "BSTR"
Case 129
GetTypeName = "char"
Case 200
GetTypeName = "varchar"
Case 201
GetTypeName = "text"
Case 130
GetTypeName = "nchar"
Case 202
GetTypeName = "nvarchar"
Case 203
GetTypeName = "ntext"
Case 128
GetTypeName = "binary"
Case 204
GetTypeName = "sql_variant"
Case 205
GetTypeName = "image"
Case 136
GetTypeName = "Chapter"
Case 64
GetTypeName = "FileTime"
Case 138
GetTypeName = "Propvariant"
Case 139
GetTypeName = "varnumeric"
Case &H2000
GetTypeName = "Array"
Case Else
GetTypeName = sFieldType
End Select
End Function
Conn_1.Close
Set Conn_1 = Nothing
Conn_2.Close
Set Conn_2 = Nothing
TxtArea = TxtArea & vbcrlf
TxtArea = TxtArea & "Conn_1.Close" & vbcrlf
TxtArea = TxtArea & "Set Conn_1 = Nothing" & vbcrlf & vbcrlf
TxtArea = TxtArea & "Conn_2.Close" & vbcrlf
TxtArea = TxtArea & "Set Conn_2 = Nothing" & vbcrlf & vbcrlf
End If
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; Charset=windows-1254">
<TITLE>DATABASE CONVERTER</TITLE>
<META HTTP-EQUIV="DESCRIPTION" CONTENT="SQL To Access / Access To SQL - Database Converter">
<META HTTP-EQUIV="KEYWORDS" CONTENT="SQL, Access, Asp, Database Converter">
<META HTTP-EQUIV="Content-Language" CONTENT="EN">
<META HTTP-EQUIV="Expires" CONTENT="0">
<META NAME="Author" CONTENT="Cenk Yurtseven, www.yurtseven.org">
<STYLE TYPE="text/css">
BODY, TD, DIV, INPUT, TEXTAREA { font-family: MS Sans Serif, Arial, Verdana; font-size: 9pt }
</STYLE>
</HEAD>
<BODY BGCOLOR="#DFD9D0">
<%=strError %>
<FORM ACTION="convertdb.asp" METHOD="get">
<TABLE WIDTH="90%" BORDER="0" CELLSPACING="1" CELLPADDING="2" BGCOLOR="#FFF9F0" ALIGN="center">
<TR>
<TD WIDTH="100%" COLSPAN="4" BGCOLOR="#FFF9F0">
<BR>
<DIV ALIGN="center">
<B>Access To SQL / SQL To Access - DATABASE CONVERTER</B></DIV>
<BR>
</TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Database Name:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0">
<INPUT TYPE="text" NAME="SqlDbName" SIZE="<%=TextBoxSize %>"></TD>
<TD COLSPAN="2" ROWSPAN="5" BGCOLOR="#DFD9D0" WIDTH="50%" ALIGN="center" NOWRAP>Access Database Name:
<INPUT TYPE="text" NAME="AccessDbName" SIZE="<%=TextBoxSize %>"><B>.mdb</B> </TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Server Address:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="ServerAddress" VALUE="localhost" SIZE="<%=TextBoxSize %>"></TD>
</TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Username:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbUsername" VALUE="sa" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Password:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbPassword" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Port:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbPort" VALUE="1433" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>Convert:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0">
<INPUT TYPE="radio" NAME="DbType" VALUE="" CHECKED>SQL to Access</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%" NOWRAP>
<INPUT TYPE="radio" NAME="DbType" VALUE="1">Access to SQL</TD><TD ROWSPAN="2" BGCOLOR="#DFD9D0" WIDTH="25%" ALIGN="center"><INPUT TYPE="submit" VALUE="Convert Database"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>Converting Type:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>
<INPUT TYPE="radio" NAME="TheValues" VALUE="1" CHECKED>Structure and Data</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%" NOWRAP>
<INPUT TYPE="radio" NAME="TheValues" VALUE="">Structure only</TD></TR>
</TABLE></FORM>
<%
If Request("ServerAddress") <> "" And Request("SqlDbName") <> "" And Request("AccessDbName") <> "" And Request("DbPort") <> "" And Request("DbPassword") <> "" Then
%>
<DIV ALIGN="center"><FORM>
<B>SQL creating the database:</B>
<BR>
<TEXTAREA COLS="<%=TextAreaCols %>" ROWS="12" NAME="SQL"><%=TxtArea %></TEXTAREA>
</FORM></DIV>
<%
End If
%>
</BODY>
</HTML>
<%
''*********************************
'' Speichern Sie diese Datei als: convertdb.asp
''*********************************
Option Explicit
Server.ScriptTimeout = 3600
Response.Buffer = True
Response.Expires = 0
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H0001
Const adUseClient = 3
Const Jet4x = 5
Dim Browser
Dim BrowserType
Dim TextBoxSize
Dim TextAreaCols
Dim strError
Dim objFSO
Dim Catalog
Dim DbPathTo
Dim DBPathFrom
Dim TheColumn
Dim TxtArea
Dim Conn_1
Dim Conn_2
Dim Table
Dim TblName
Dim SQL
Dim strSQL
Dim RS_0
Dim FldName
Dim cType
Dim cSize
Dim RS_2
Dim strSQL1
Dim RS_1
Dim tbCount
Dim flCount
Dim rcCount
Dim FieldStr
Dim ValueStr
Dim varTemp
Dim RS_1FldNameName
Browser = Request.ServerVariables("HTTP_USER_AGENT")
If InStr(Browser, "MSIE") Then
BrowserType = "Microsoft"
TextBoxSize = 20
TextAreaCols = 120
Else
BrowserType = "Other"
TextBoxSize = 14
TextAreaCols = 65
End If
If Request("ServerAddress") <> "" And Request("SqlDbName") <> "" And Request("AccessDbName") <> "" And Request("DbPort") <> "" And Request("DbPassword") <> "" And Request("DbUsername") <> "" Then
On Error Resume Next
If Request("DbType") = "" Then
CreateNewMDB Server.MapPath(Request("AccessDbName") & ".mdb"), Jet4x
DbPathTo = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath(Request("AccessDbName") & ".mdb") & ";"
DBPathFrom = "DRIVER=SQL Server; SERVER=" & Request("ServerAddress") & "; DATABASE=" & Request("SqlDbName") & "; PORT=" & Request("DbPort") & "; UID=" & Request("DbUsername") & "; PASSWORD=" & Request("DbPassword") & ";"
TheColumn = " COLUMN"
Else
DBPathFrom = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath(Request("AccessDbName") & ".mdb") & ";"
DbPathTo = "DRIVER=SQL Server; SERVER=" & Request("ServerAddress") & "; DATABASE=" & Request("SqlDbName") & "; PORT=" & Request("DbPort") & "; UID=" & Request("DbUsername") & "; PASSWORD=" & Request("DbPassword") & ";"
TheColumn = ""
End If
TxtArea = vbcrlf & vbcrlf
Set Conn_1 = Server.CreateObject("ADODB.Connection")
Conn_1.Open DBPathFrom
TxtArea = TxtArea & "DBPathFrom = "" & DBPathFrom & """ & vbcrlf
TxtArea = TxtArea & "Set Conn_1 = Server.CreateObject("ADODB.Connection")" & vbcrlf
TxtArea = TxtArea & "Conn_1.Open DBPathFrom" & vbcrlf & vbcrlf
Set Conn_2 = Server.CreateObject("ADODB.Connection")
Conn_2.Open DbPathTo
TxtArea = TxtArea & "DbPathTo = "" & DbPathTo & """ & vbcrlf
TxtArea = TxtArea & "Set Conn_2 = Server.CreateObject("ADODB.Connection")" & vbcrlf
TxtArea = TxtArea & "Conn_2.Open DbPathTo" & vbcrlf & vbcrlf
If Err = 0 Then
Set Table = Conn_1.OpenSchema(20)
tbCount = 0
While Not Table.EOF
TblName = Table("Table_Name")
If UCase(Left(TblName, 4)) <> "MSYS" And UCase(Left(TblName, 3)) <> "SYS" And UCase(Left(TblName, 4)) <> "RTBL" And UCase(Left(TblName, 3)) <> "DTP" Then
On Error Resume Next
tbCount = tbCount + 1
If Request("DbType") = "" Then
SQL = "CREATE TABLE " & TblName & " (" & TblName & "ID Counter NOT NULL CONSTRAINT [pk" & TblName & "ID] PRIMARY KEY)"
Else
SQL = "CREATE TABLE " & TblName & " (" & TblName & "ID integer IDENTITY (1, 1) NOT NULL CONSTRAINT [pk" & TblName & "ID] PRIMARY KEY)"
End If
Conn_2.Execute(SQL)
TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
strSQL = "SELECT * FROM " & TblName
Set RS_0 = Conn_1.Execute(strSQL)
flCount = 0
For Each FldName In RS_0.Fields
flCount = flCount + 1
If FldName.attributes <> 16 Then
cType = GetTypeName(FldName.Type)
cSize = FldName.DefinedSize
If cType = "varchar" Or cType = "nvarchar" Then
cSize = " (" & cSize & ")"
Else
cSize = ""
End If
SQL = "ALTER TABLE " & TblName & " ADD" & TheColumn & " " & FldName.Name & " " & cType & cSize & " NULL"
Conn_2.Execute(SQL)
TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
Set RS_2 = Conn_1.openSchema(12)
Do While Not RS_2.EOF
If RS_2("Table_Name") = TblName Then
If RS_2("Column_Name") = FldName.Name Then
If (RS_2("Unique") = True) Then
SQL = "ALTER TABLE " & TblName & " ALTER COLUMN " & FldName.Name & " " & cType & cSize & " NULL CONSTRAINT [idx" & FldName.Name & "] UNIQUE"
Conn_2.Execute(SQL)
TxtArea = TxtArea & "SQL = "" & SQL & """ & vbcrlf
TxtArea = TxtArea & "Conn_2.Execute(strSQL)" & vbcrlf
End If
End If
End If
RS_2.MoveNext
Loop
RS_2.Close
Set RS_2 = Nothing
End If
Next
RS_0.Close
Set RS_0 = Nothing
If Request("TheValues") <> "" Then
On Error Resume Next
strSQL1 = "SELECT * FROM " & TblName & " ORDER BY " & TblName & "ID ASC"
Set RS_1 = Server.CreateObject("ADODB.Recordset")
RS_1.CursorLocation = adUseClient
RS_1.Open (strSQL1), Conn_1, adOpenForwardOnly, adLockReadOnly, adCmdText
rcCount = 0
If Not RS_1.EOF Then
Do Until RS_1.EOF
rcCount = rcCount + 1
FieldStr = " ("
ValueStr = " VALUES ("
For Each FldName In RS_1.Fields
If FldName.attributes <> 16 Then
cType = GetTypeName(FldName.Type)
If cType = "integer" Or cType = "smallint" Or cType = "double" Or cType = "bigint" Then
RS_1FldNameName = RS_1(FldName.Name)
If RS_1FldNameName <> "" Then
FieldStr = FieldStr & FldName.Name & ", "
ValueStr = ValueStr & RS_1FldNameName & ", "
Else
FieldStr = FieldStr & FldName.Name & ", "
ValueStr = ValueStr & "0, "
End If
Else
RS_1FldNameName = CheckString(RS_1(FldName.Name))
If cType = "bit" Or cType = "yesno" Then
If RS_1FldNameName = "True" Then
RS_1FldNameName = "1"
Else
RS_1FldNameName = "0"
End If
End If
If RS_1FldNameName <> "" Then
FieldStr = FieldStr & FldName.Name & ", "
ValueStr = ValueStr & "''" & RS_1FldNameName & "'', "
End If
End If
End If
Next
If Len(FieldStr) > 3 And Len(ValueStr) > 12 Then
FieldStr = Mid(FieldStr, 1, Len(FieldStr) - 2) & ")"
ValueStr = Mid(ValueStr, 1, Len(ValueStr) - 2) & ")"
strSQL = "INSERT INTO " & TblName & FieldStr & ValueStr
Conn_2.Execute(strSQL)
End If
RS_1.MoveNext
Loop
End If
RS_1.Close
Set RS_1 = Nothing
End If
End If
Table.MoveNext
Wend
Response.Write "<DIV ALIGN=""center""><BR><B><FONT COLOR=""#0000CC"">The Database has been converted successfully!</FONT></B></DIV>"
End If
Sub CreateNewMDB(FileName, Format)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(FileName) Then
Response.Write "<DIV ALIGN=""center""><BR><B><FONT COLOR=""#CC0000"">Database Already Exists.</FONT></B></DIV>" &vbcrlf
Set objFSO = Nothing
Exit Sub
End If
Set objFSO = Nothing
If Err Then
Exit Sub
Else
Set Catalog = Server.CreateObject("ADOX.Catalog")
Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & "Jet OLEDB:Engine Type=" & Format & ";Data Source=" & FileName
Set Catalog = Nothing
End If
End Sub
Function CheckString(varValue)
varTemp = varValue
On Error Resume Next
varTemp = Replace(varTemp, "''", "''")
varTemp = Replace(varTemp, """", """")
varTemp = Replace(varTemp, "%", chr(37))
varTemp = Trim(varTemp)
CheckString = varTemp
End Function
Private Function GetTypeName(ByVal sFieldType)
Select Case sFieldType
Case 0
GetTypeName = "Empty"
Case 16
GetTypeName = "tinyint"
Case 2
GetTypeName = "smallint"
Case 3
GetTypeName = "int"
Case 20
GetTypeName = "bigint"
Case 17
GetTypeName = "tinyint"
Case 18
GetTypeName = "smallint"
Case 19
GetTypeName = "int"
Case 21
GetTypeName = "bigint"
Case 4
GetTypeName = "real"
Case 5
GetTypeName = "float"
Case 6
GetTypeName = "money"
Case 14
GetTypeName = "decimal"
Case 131
GetTypeName = "numeric"
Case 11
GetTypeName = "bit"
Case 10
GetTypeName = "Error"
Case 132
GetTypeName = "UserDefined"
Case 12
GetTypeName = "variant"
Case 9
GetTypeName = "IDispatch"
Case 13
GetTypeName = "IUnknown"
Case 72
GetTypeName = "uniqueidentifier"
Case 7, 133, 134, 135
GetTypeName = "datetime"
Case 8
GetTypeName = "BSTR"
Case 129
GetTypeName = "char"
Case 200
GetTypeName = "varchar"
Case 201
GetTypeName = "text"
Case 130
GetTypeName = "nchar"
Case 202
GetTypeName = "nvarchar"
Case 203
GetTypeName = "ntext"
Case 128
GetTypeName = "binary"
Case 204
GetTypeName = "sql_variant"
Case 205
GetTypeName = "image"
Case 136
GetTypeName = "Chapter"
Case 64
GetTypeName = "FileTime"
Case 138
GetTypeName = "Propvariant"
Case 139
GetTypeName = "varnumeric"
Case &H2000
GetTypeName = "Array"
Case Else
GetTypeName = sFieldType
End Select
End Function
Conn_1.Close
Set Conn_1 = Nothing
Conn_2.Close
Set Conn_2 = Nothing
TxtArea = TxtArea & vbcrlf
TxtArea = TxtArea & "Conn_1.Close" & vbcrlf
TxtArea = TxtArea & "Set Conn_1 = Nothing" & vbcrlf & vbcrlf
TxtArea = TxtArea & "Conn_2.Close" & vbcrlf
TxtArea = TxtArea & "Set Conn_2 = Nothing" & vbcrlf & vbcrlf
End If
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; Charset=windows-1254">
<TITLE>DATABASE CONVERTER</TITLE>
<META HTTP-EQUIV="DESCRIPTION" CONTENT="SQL To Access / Access To SQL - Database Converter">
<META HTTP-EQUIV="KEYWORDS" CONTENT="SQL, Access, Asp, Database Converter">
<META HTTP-EQUIV="Content-Language" CONTENT="EN">
<META HTTP-EQUIV="Expires" CONTENT="0">
<META NAME="Author" CONTENT="Cenk Yurtseven, www.yurtseven.org">
<STYLE TYPE="text/css">
BODY, TD, DIV, INPUT, TEXTAREA { font-family: MS Sans Serif, Arial, Verdana; font-size: 9pt }
</STYLE>
</HEAD>
<BODY BGCOLOR="#DFD9D0">
<%=strError %>
<FORM ACTION="convertdb.asp" METHOD="get">
<TABLE WIDTH="90%" BORDER="0" CELLSPACING="1" CELLPADDING="2" BGCOLOR="#FFF9F0" ALIGN="center">
<TR>
<TD WIDTH="100%" COLSPAN="4" BGCOLOR="#FFF9F0">
<BR>
<DIV ALIGN="center">
<B>Access To SQL / SQL To Access - DATABASE CONVERTER</B></DIV>
<BR>
</TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Database Name:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0">
<INPUT TYPE="text" NAME="SqlDbName" SIZE="<%=TextBoxSize %>"></TD>
<TD COLSPAN="2" ROWSPAN="5" BGCOLOR="#DFD9D0" WIDTH="50%" ALIGN="center" NOWRAP>Access Database Name:
<INPUT TYPE="text" NAME="AccessDbName" SIZE="<%=TextBoxSize %>"><B>.mdb</B> </TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Server Address:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="ServerAddress" VALUE="localhost" SIZE="<%=TextBoxSize %>"></TD>
</TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Username:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbUsername" VALUE="sa" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Password:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbPassword" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>SQL Port:</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%">
<INPUT TYPE="text" NAME="DbPort" VALUE="1433" SIZE="<%=TextBoxSize %>"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>Convert:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0">
<INPUT TYPE="radio" NAME="DbType" VALUE="" CHECKED>SQL to Access</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%" NOWRAP>
<INPUT TYPE="radio" NAME="DbType" VALUE="1">Access to SQL</TD><TD ROWSPAN="2" BGCOLOR="#DFD9D0" WIDTH="25%" ALIGN="center"><INPUT TYPE="submit" VALUE="Convert Database"></TD></TR>
<TR>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>Converting Type:</TD>
<TD WIDTH="25%" BGCOLOR="#DFD9D0" NOWRAP>
<INPUT TYPE="radio" NAME="TheValues" VALUE="1" CHECKED>Structure and Data</TD>
<TD BGCOLOR="#DFD9D0" WIDTH="25%" NOWRAP>
<INPUT TYPE="radio" NAME="TheValues" VALUE="">Structure only</TD></TR>
</TABLE></FORM>
<%
If Request("ServerAddress") <> "" And Request("SqlDbName") <> "" And Request("AccessDbName") <> "" And Request("DbPort") <> "" And Request("DbPassword") <> "" Then
%>
<DIV ALIGN="center"><FORM>
<B>SQL creating the database:</B>
<BR>
<TEXTAREA COLS="<%=TextAreaCols %>" ROWS="12" NAME="SQL"><%=TxtArea %></TEXTAREA>
</FORM></DIV>
<%
End If
%>
</BODY>
</HTML>
