Копирует структуру и данные из MySQL в MsSQL. Только _заданные_ таблицы, _определенные_ типы данных и _без_ NOT NULL и KEYS. Индексы тоже не переносятся. Что мне и надо было.
Хотел сделать через ADOX, но на своем компе не обнаружил ссылку на такую библиотеку. Не был в теме последние 5 лет и может MS похерела эту библиотеку, не знаю.
У меня отработало на 200 Мб базе MySQL через инет.
Так что, если кого заинтересует может взять за основу и переделать.
Понятно, что должно стоять ADODB (ранее качал MDAC - сейчас не знаю, я использовал ссылку Microsoft ActiveX Data Objects 6.0 Library с провайдером SQLNative) и драйвера MySQL (использовал версия 5.1).
Понятно, что надо видоизменить процедуру pMetaSourceAndDest.
- Код: Выделить всё
Option Explicit
Public Sub Main()
' Локальные переменные
Dim i As Long
Dim j As Long
Dim lRecorsAffected As Long
' Источник
Dim sSrcConnString As String
Dim arSrcTables As Variant
Dim oConnSrc As ADODB.Connection
Dim oRsSrc As ADODB.Recordset
Dim oFldSrc As ADODB.Field
Dim sTableSrc As String
Dim sTypeSrc As String
' Получатель
Dim sDstConnString As String
Dim oConnDst As ADODB.Connection
Dim sSQLDst As String
Dim oRsDst As ADODB.Recordset
' Получение метаданных
Call pMetaSourceAndDest(sSrcConnString, arSrcTables, sDstConnString)
' Открываем источник
Set oConnSrc = New ADODB.Connection
With oConnSrc
.ConnectionString = sSrcConnString
.CursorLocation = adUseClient
.Open
End With
' Открываем получатель
Set oConnDst = New ADODB.Connection
With oConnDst
.ConnectionString = sDstConnString
.CursorLocation = adUseClient
.Open
End With
' Проходимся по всем таблицам
For i = LBound(arSrcTables) To UBound(arSrcTables)
' Имя таблицы
sTableSrc = arSrcTables(i)
' Чистим получателя
sSQLDst = "IF EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[" & sTableSrc & "]') AND type in (N'U')) DROP TABLE [dbo].[" & sTableSrc & "]"
oConnDst.Execute sSQLDst, lRecorsAffected
sSQLDst = ""
' Читаем структуру источника
Debug.Print "Создаем *** " & sTableSrc & " ***"
Set oRsSrc = New ADODB.Recordset
With oRsSrc
Set .ActiveConnection = oConnSrc
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Source = "SELECT * FROM " & sTableSrc & " WHERE 1=0"
.Open
For Each oFldSrc In .Fields
'Debug.Print oFldSrc.Name, pFieldType(oFldSrc.Type, oFldSrc.DefinedSize), oFldSrc.DefinedSize
sSQLDst = sSQLDst & IIf(Len(sSQLDst) > 0, ", ", "") & "[" & oFldSrc.Name & "] " & pFieldType(oFldSrc.Type, oFldSrc.DefinedSize)
Next
.Close
End With
Set oRsSrc = Nothing
' Создаем структуру получателя
sSQLDst = "CREATE TABLE [dbo].[" & sTableSrc & "] (" & sSQLDst & ")"
oConnDst.Execute sSQLDst, lRecorsAffected
sSQLDst = ""
' Копируем данные
Debug.Print "Копируем *** " & sTableSrc & " ***"
' -- Источник
Set oRsSrc = New ADODB.Recordset
With oRsSrc
Set .ActiveConnection = oConnSrc
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Source = "SELECT * FROM " & sTableSrc
.Open
End With
' -- Получатель
Set oRsDst = New ADODB.Recordset
With oRsDst
Set .ActiveConnection = oConnDst
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Source = "SELECT * FROM " & sTableSrc & " WHERE 1=0"
.Open
End With
' -- По всему источник
j = 0
Do While Not oRsSrc.EOF
j = j + 1
oRsDst.AddNew
For Each oFldSrc In oRsSrc.Fields
oRsDst.Fields(oFldSrc.Name).Value = oFldSrc.Value
Next
oRsDst.Update
oRsSrc.MoveNext
Loop
Debug.Print "*** Скопировали " & sTableSrc & " ***: строк - " & CStr(j)
' Источник
oRsSrc.Close
Set oRsSrc = Nothing
' Получатель
oRsDst.Close
Set oRsDst = Nothing
Next
' Закрываем соединение
If oConnSrc.State = adStateOpen Then oConnSrc.Close
If oConnDst.State = adStateOpen Then oConnDst.Close
Set oConnSrc = Nothing
Set oConnDst = Nothing
End Sub
Private Function pFieldType(ByVal enDataType As DataTypeEnum, ByVal lSize As Long) As String
Select Case enDataType:
'Case adArray: pFieldType = "adArray"
'Case adBigInt: pFieldType = "adBigInt"
'Case adBinary: pFieldType = "adBinary"
'Case adBoolean: pFieldType = "adBoolean"
'Case adBSTR: pFieldType = "adBSTR"
'Case adChapter: pFieldType = "adChapter"
'Case adChar: pFieldType = "adChar"
'Case adCurrency: pFieldType = "adCurrency"
'Case adDate: pFieldType = "adDate"
'Case adDBDate: pFieldType = "adDBDate"
'Case adDBTime: pFieldType = "adDBTime"
'Case adDBTimeStamp: pFieldType = "adDBTimeStamp"
'Case adDecimal: pFieldType = "adDecimal"
'Case adDouble: pFieldType = "adDouble"
'Case adEmpty: pFieldType = "adEmpty"
'Case adError: pFieldType = "adError"
'Case adFileTime: pFieldType = "adFileTime"
'Case adGUID: pFieldType = "adGUID"
'Case adIDispatch: pFieldType = "adIDispatch"
Case adInteger: pFieldType = "int" ' "adInteger"
'Case adIUnknown: pFieldType = "adIUnknown"
'Case adLongVarBinary: pFieldType = "adLongVarBinary"
'Case adLongVarChar: pFieldType = "adLongVarChar"
Case adLongVarWChar: pFieldType = "ntext" ' "adLongVarWChar"
'Case adNumeric: pFieldType = "adNumeric"
'Case adPropVariant: pFieldType = "adPropVariant"
'Case adSingle: pFieldType = "adSingle"
'Case adSmallInt: pFieldType = "adSmallInt"
'Case adTinyInt: pFieldType = "adTinyInt"
'Case adUnsignedBigInt: pFieldType = "adUnsignedBigInt"
'Case adUnsignedInt: pFieldType = "adUnsignedInt"
'Case adUnsignedSmallInt: pFieldType = "adUnsignedSmallInt"
'Case adUnsignedTinyInt: pFieldType = "adUnsignedTinyInt"
'Case adUserDefined: pFieldType = "adUserDefined"
'Case adVarBinary: pFieldType = "adVarBinary"
Case adVarChar: pFieldType = "varchar(" & CStr(lSize) & ")" ' "adVarChar"
'Case adVariant: pFieldType = "adVariant"
'Case adVarNumeric: pFieldType = "adVarNumeric"
Case adVarWChar: pFieldType = "nvarchar(" & CStr(lSize) & ")" ' "adVarWChar"
Case adWChar: pFieldType = "varchar(" & CStr(lSize) & ")" ' "adWChar"
Case Else: Err.Raise 0, , "Unknown type" 'pFieldType = "(unknown)"
End Select
End Function
Private Sub pMetaSourceAndDest(ByRef sSrcConnString As String, ByRef arSrcTables As Variant, ByRef sDstConnString As String)
' Источник
sSrcConnString = "Driver={MySQL ODBC 5.1 Driver};Server=SERVER_NAME;Port=3306;charset=cp1251;Database=DB_NAME;User=DB_USER;Password=DB_PASSWORD;Option=3;"
arSrcTables = Array("news", "users", "texts", "etc")
' Получатель
sDstConnString = "Provider=SQLNCLI10.1;Integrated Security="""";Persist Security Info=False;User ID=sa;Initial Catalog=DB_NAME_DEST;Data Source=(local);Initial File Name="""";Server SPN="""""
End Sub