Так что я что-то написал. Этот код специфичен для Postgres (если вы можете выбрать, это было бы очень приятно выбрать. В противном случае возьмите Firebird, это также чрезвычайно приятная БД, но вы должны разделить инструкции вставки во множестве «вставить в»
Imports ADODB
Public Class ExcelToPostgres
Implements XToY
Dim cn As ADODB.Connection
Dim o As OleDb.OleDbConnection
Dim _Serials As ArrayList
Private _Txt As New System.Text.StringBuilder("")
Private _ForeignsTxt As New System.Text.StringBuilder("")
Private _Q As Boolean 'Quote all
Private p_Database As New ArrayList
Private P_Definition As Boolean = True
Private P_Data As Boolean = True
Private h_TAbles As SortedList(Of String, DBTable)
Private Quoter As New DbQuoter(dbEnum.ePostgres)
Public Property SetTables(ByVal Name As String) As Boolean Implements XToY.SetTables
Get
Return (h_TAbles(Name).IsSelected)
End Get
Set(ByVal value As Boolean)
h_TAbles(Name).IsSelected = value
End Set
End Property
Public Property UseQuotes As Boolean Implements XToY.UseQuotes
Get
Return _Q
End Get
Set(ByVal value As Boolean)
_Q = value
End Set
End Property
Public ReadOnly Property Tables() As SortedList(Of String, DBTable) Implements XToY.Tables
Get
Return h_TAbles
End Get
End Property
Public Property Definition As Boolean Implements XToY.Definition
Set(ByVal value As Boolean)
P_Definition = value
End Set
Get
Return P_Definition
End Get
End Property
Public Property Data As Boolean Implements XToY.Data
Set(ByVal value As Boolean)
P_Data = value
End Set
Get
Return P_Data
End Get
End Property
Sub New(ByVal dbpath As String, ByVal user As String, ByVal password As String)
Dim strCn As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & dbpath & ";Extended Properties=Excel 8.0"
';Extended Properties=Excel 8.0;HDR=Yes;IMEX=1
o = New OleDb.OleDbConnection(strCn)
o.Open()
LoadTables()
End Sub
Private Sub LoadTables()
Dim dt As DataTable
Dim ch() As Char = {"'", Chr(34), " "}
dt = o.GetOleDbSchemaTable(OleDb.OleDbSchemaGuid.Tables, Nothing)
h_TAbles = New SortedList(Of String, DBTable)
Dim dbt As DBTable
For Each row As DataRow In dt.Rows
Dim tablename As String = DirectCast(row("TABLE_NAME"), String)
If tablename.Trim(ch).EndsWith("$") Then
dbt = New DBTable()
dbt.Name = tablename
dbt.DBTarget = "Postgres"
dbt.IsSelected = True
h_TAbles.Add(tablename, dbt)
End If
Next
LoadColumns()
End Sub
Private Sub LoadColumns()
Dim dt As DataTable
Dim dv As DataView
Dim c As ColumnTable
For Each d As KeyValuePair(Of String, DBTable) In h_TAbles
dt = o.GetOleDbSchemaTable(OleDb.OleDbSchemaGuid.Columns, New String() {Nothing, Nothing, d.Key, Nothing})
dv = dt.DefaultView
dv.Sort = "ORDINAL_POSITION"
For i As Integer = 0 To dv.Count - 1
c = New ColumnTable
c.Name = dv.Item(i).Item("COLUMN_NAME")
c.NewName = QuoteName(dv.Item(i).Item("COLUMN_NAME"))
c.Type = Me.TypeAsString(dv.Item(i).Item("DATA_TYPE"), c.IsAutoincrement)
Select Case dv.Item(i).Item("DATA_TYPE")
Case 7, 8, 200, 201, 202, 203, 129, 130, 72, 129, 130, 32770
c.NeedQuote = True
c.NeedQuoteUserSetting = True
End Select
c.IsAutoincrement = False
c.IsNullable = True
c.IsSelected = True
d.Value.Columns.Add(c)
Next
Next
End Sub
Public Function Export() As String Implements XToY.Export
_Txt = New System.Text.StringBuilder("")
For Each a As KeyValuePair(Of String, DBTable) In h_TAbles
If a.Value.IsSelected Then
Me.CreateTables(a.Key)
_Txt.Append(vbNewLine)
End If
Next
' _Txt.Append(_ForeignsTxt.ToString)
Return _Txt.ToString
End Function
Private Sub CreateTables(ByVal Table As String)
Dim sTable As String = QuoteName(Table)
If Definition Then
_Txt.Append(String.Format("DO $$DECLARE r record; {0}" & _
"BEGIN {0}" & _
" FOR r IN SELECT conname, c.relname as tTab {0}" & _
" FROM pg_constraint ct {0}" & _
" inner join pg_class c on c.oid= ct.conrelid {0}" & _
" inner join pg_class c1 on c1.oid= ct.confrelid {0}" & _
" where contype='f' AND c1.relname ='{1}' {0}" & _
" LOOP {0}" & _
" EXECUTE 'ALTER TABLE ' || quote_ident(r.ttab) || ' DROP CONSTRAINT ' || quote_ident(r.conname); {0}" & _
" END LOOP; {0}" & _
"END$$; {0}", vbNewLine, sTable))
_Txt.Append("DROP TABLE IF EXISTS ")
_Txt.Append(sTable)
_Txt.Append(";")
_Txt.Append(vbNewLine)
_Txt.Append("CREATE TABLE IF NOT EXISTS ")
_Txt.Append(sTable)
_Txt.Append(" (")
CreateColumns(Table)
'CreateConstraints(Table)
'_Txt.Append(vbNewLine)
_Txt.Append("); ")
_Txt.Append(vbNewLine)
_Txt.Append(vbNewLine)
End If
If Data Then
_Serials = New ArrayList
Me.DataPump(Table)
_Txt.Append(vbNewLine)
For i = 0 To Me._Serials.Count - 1
_Txt.Append("Select setval(pg_get_serial_sequence('")
_Txt.Append(sTable)
_Txt.Append("','")
'_Txt.Append(Chr(34))
_Txt.Append(_Serials(i))
'_Txt.Append(Chr(34))
_Txt.Append("'), (Select max(")
_Txt.Append(QuoteName(_Serials(i)))
_Txt.Append(") from ")
_Txt.Append(sTable)
_Txt.Append(")); ")
_Txt.Append(vbNewLine)
Next
End If
End Sub
Private Sub CreateColumns(ByVal idTable As String)
Dim b As Boolean = False
With h_TAbles(idTable)
For i As Integer = 0 To .Columns.Count - 1
With CType(.Columns(i), ColumnTable)
If .IsSelected Then
If b Then
_Txt.Append(",")
Else
b = True
End If
_Txt.Append(vbNewLine)
_Txt.Append(.NewName)
_Txt.Append(" ")
If .IsAutoincrement Then
_Serials.Add(.NewName)
Else
_Txt.Append(.Type)
End If
_Txt.Append(" ")
If .DefaultValue <> "" Then
_Txt.Append(" DEFAULT ")
_Txt.Append(.DefaultValue)
End If
If Not .IsNullable Then _Txt.Append(" NOT NULL")
End If
End With
Next
End With
End Sub
Private Function TypeAsString(ByVal InternalId As Integer, ByVal isautoincrement As Boolean) As String
Select Case InternalId
Case 2, 16, 17, 18
Return " smallint "
Case 3, 19
If isautoincrement Then Return " Serial "
Return " int "
Case 4
Return " real "
Case 5
Return " double precision "
Case 6
Return " Money "
Case 7
Return " timestamp "
Case 8, 200, 201, 202, 203
Return " text "
Case 11
Return " boolean "
Case 72
Return " uuid "
Case 128
Return " bytea "
Case 129, 130
Return " text "
Case 131
Return " numeric "
Case 32769, 20, 21
If isautoincrement Then Return " bigserial "
Return " BIGINT "
Case 32771
Return " BLOB "
Case 32770
Return " TEXT "
Case Else
Throw New InvalidConstraintException("Type ID=" & InternalId & " Not Recognized")
End Select
End Function
Private Sub CreateConstraints(ByVal idTable As String)
Dim rsTbl, rsPk As Recordset
rsTbl = cn.OpenSchema(SchemaEnum.adSchemaTableConstraints, _
New Object() {Nothing, Nothing, Nothing, Nothing, Nothing, idTable, Nothing})
rsPk = cn.OpenSchema(SchemaEnum.adSchemaPrimaryKeys, New Object() {Nothing, Nothing, idTable})
Dim i As Integer
_Txt.Append(vbNewLine)
If Not rsPk.EOF Then 'primary key
_Txt.Append(",")
_Txt.Append(vbNewLine)
_Txt.Append("CONSTRAINT ")
rsTbl.Filter = "CONSTRAINT_TYPE='PRIMARY KEY'"
_Txt.Append(Chr(34))
_Txt.Append(idTable)
_Txt.Append("_")
_Txt.Append(rsTbl.Fields("CONSTRAINT_NAME").Value)
_Txt.Append(Chr(34))
_Txt.Append(" PRIMARY KEY(")
i = 1
rsPk.Filter = "ORDINAL=" & i
Do Until rsPk.EOF
If i > 1 Then _Txt.Append(",")
_Txt.Append(QuoteName(rsPk.Fields("COLUMN_NAME").Value))
i = i + 1
rsPk.Filter = "ORDINAL=" & i
Loop
_Txt.Append(")")
End If
rsPk.Close()
_Txt.Append(vbNewLine)
End Sub
Private Sub DataPump(ByVal idTable As String)
Dim dt As DataTable
'Dim dv As DataView
Dim hsh As New Hashtable
dt = o.GetOleDbSchemaTable(OleDb.OleDbSchemaGuid.Columns, New String() {Nothing, Nothing, idTable, Nothing})
For k As Integer = 0 To dt.Rows.Count - 1
hsh.Add(dt.Rows(k).Item("COLUMN_NAME"), dt.Rows(k).Item("DATA_TYPE"))
Next
'Dim ch() As Char = {"'", " ", Chr(34)}
'Dim ch2() As Char = {Chr(34)}
Dim st As String = idTable '.Trim(ch)
If Left(st, 1) = Chr(34) Then st = Mid(st, 2, Len(st) - 2)
If st.EndsWith("$") Then st = Left(st, Len(st) - 1)
Dim sTable As String = QuoteName(st)
Dim tbl As DBTable
Dim i As Integer
Dim b As Boolean = False
Dim qryString As New System.Text.StringBuilder("")
tbl = h_TAbles(idTable)
If tbl.IsQuery Then
qryString.Append(tbl.QueryString)
Else
qryString.Append("SELECT ")
For i = 0 To tbl.Columns.Count - 1
If tbl.Columns(i).IsSelected Then
If b Then qryString.Append(",")
qryString.Append("[")
'If Left(tbl.Columns(i).Name, 1) = Chr(34) Then
' qryString.Append(Mid(tbl.Columns(i).Name, 2, Len(tbl.Columns(i).Name) - 2))
'Else
qryString.Append(tbl.Columns(i).Name)
'End If
qryString.Append("]")
b = True
End If
Next
qryString.Append(" FROM ")
qryString.Append("[")
qryString.Append(idTable)
qryString.Append("]")
End If
'Dim oComm As New OleDb.OleDbCommand("Select * From [" & idTable & "]", o)
Dim oDat As OleDb.OleDbDataAdapter = New OleDb.OleDbDataAdapter(qryString.ToString, o)
dt = New DataTable
oDat.Fill(dt)
Dim InsertString As New System.Text.StringBuilder("INSERT INTO ")
InsertString.Append(sTable)
InsertString.Append("(")
b = False
For i = 0 To tbl.Columns.Count - 1
If tbl.Columns(i).IsSelected Then
If b Then InsertString.Append(",")
InsertString.Append(tbl.Columns(i).NewName)
b = True
End If
Next
InsertString.Append(") VALUES ")
Dim ci As New System.Globalization.CultureInfo("en-US")
System.Threading.Thread.CurrentThread.CurrentCulture = ci
Dim h As Boolean
Dim clmName As String
b = False
_Txt.Append(InsertString.ToString)
For i = 0 To dt.Rows.Count - 1
If b Then
_Txt.Append(",")
Else
b = True
End If
_Txt.Append(vbNewLine)
_Txt.Append("(")
h = False
For j As Integer = 0 To tbl.Columns.Count - 1
If tbl.Columns(j).IsSelected Then
If h Then
_Txt.Append(", ")
Else
h = True
End If
clmName = tbl.Columns(j).Name '.Trim(ch)
If TypeOf (dt.Rows(i).Item(clmName)) Is DBNull Then
_Txt.Append("NULL")
ElseIf tbl.Columns(j).NeedQuote <> tbl.Columns(j).NeedQuoteUserSetting Or Not hsh.Contains(clmName) Then
_Txt.Append(Me.PrepareCustomString(dt.Rows(i).Item(clmName), tbl.Columns(j).Type, tbl.Columns(j).NeedQuoteUserSetting))
Else
_Txt.Append(Me.PrepareDataString(dt.Rows(i).Item(clmName), hsh.Item(clmName)))
End If
End If
Next
_Txt.Append(")")
Next
_Txt.Append(";")
End Sub
Private Function PrepareCustomString(ByVal Dr As String, Type As String, NeedQuote As Boolean) As String
Dim Typetxt As New System.Text.StringBuilder
Select Case Type
Case "DATETIME", "TIMESTAMP"
Typetxt.Append(" to_timestamp('")
Typetxt.Append(CType(Dr, DateTime).ToString("dd-MM-yyy hh:mm:ss"))
Typetxt.Append("','dd-MM-yyy hh24:mi:ss')")
Case "DATE"
Typetxt.Append(" to_timestamp('")
Typetxt.Append(CType(Dr, DateTime).ToString("dd-MM-yyy"))
Typetxt.Append("','dd-MM-yyy')")
Case "TIME"
Typetxt.Append(" to_timestamp(('")
Typetxt.Append(CType(Dr, DateTime).ToString("hh:mm:ss"))
Typetxt.Append("','hh24:mi:ss')")
Case "YEAR"
Typetxt.Append(" to_timestamp('")
Typetxt.Append(CType(Dr, DateTime).ToString("yyyy"))
Typetxt.Append("','yyyy')")
Case Else
If NeedQuote Then
Typetxt.Append("'")
Dim s As String = Dr
For i As Integer = 0 To s.Length - 1
Typetxt.Append(s(i))
If s(i) = "'" Then Typetxt.Append("'")
Next
Typetxt.Append("'")
Else
Typetxt.Append(Dr.Replace(",", "."))
End If
End Select
Return Typetxt.ToString
End Function
Private Function NeedGrave(ByVal IDType As Integer) As String
Select Case IDType
Case 8, 200, 201, 202, 203, 129, 130, 32770, 7, 11
Return "'"
Case Else
Return ""
End Select
End Function
Private Function PrepareDataString(ByVal Dr As Object, ByVal dt As ADODB.DataTypeEnum) As String
'DataType Enum |Value |Access |SQLServer |Oracle
'--------------------------------------------------------------------------------------------------------
'adBigInt |20 | |BigInt |
'adBinary |128 | |Binary |Raw *
' | | |TimeStamp |
'adBoolean |11 |YesNo |Bit |
'adChar |129 | |Char |Char
'adCurrency |6 |Currency |Money |
' | | |SmallMoney |
'adDate |7 |Date |DateTime |
'adDBTimeStamp |135 |DateTime |DateTime |Date
' | | |SmallDateTime |
'adDecimal |14 | | |Decimal *
'adDouble |5 |Double |Float |Float
'adGUID |72 |ReplicationID |UniqueIdentifier |
'adIDispatch |9 | | |
'adInteger |3 |AutoNumber |Identity |Int *
' | |Integer |Int |
' | |Long | |
'adLongVarBinary |205 |OLEObject |Image |Long Raw *
' | | | |Blob
'adLongVarChar |201 |Memo |Text |Long *
' | |Hyperlink | |Clob
'adLongVarWChar |203 |Memo |NText (SQL Server 7.0 +) |NClob
' | |Hyperlink | |
'adNumeric |131 |Decimal |Decimal |Decimal
' | | |Numeric |Integer
' | | | |Number
' | | | |SmallInt
'adSingle |4 |Single |Real |
'adSmallInt |2 |Integer |SmallInt |
'adUnsignedTinyInt |17 |Byte |TinyInt |
'adVarBinary |204 |ReplicationID |VarBinary |
'adVarChar |200 |Text |VarChar |VarChar
'adVariant |12 | |Sql_Variant |VarChar2
'adVarWChar |202 |Text |NVarChar |NVarChar2
'adWChar |130 | |NChar |
Dim DataString As New System.Text.StringBuilder("")
Select Case dt
Case 0
DataString.Append("NULL")
Case 2, 3, 16, 17, 18 'int,small end big
DataString.Append(Dr)
Case 4, 5, 6, 131 'float,double
DataString.Append(Dr.ToString.Replace(",", "."))
Case 7 'datetime
DataString.Append("to_timestamp('")
DataString.Append(CType(Dr, DateTime).ToString("dd-MM-yyy hh:mm:ss"))
DataString.Append("','dd-MM-yyy hh24:mi:ss')")
Case 8, 200, 201, 202, 203, 129, 130, 32770 'varchar
DataString.Append("'")
Dim s As String = Dr
For i As Integer = 0 To s.Length - 1
DataString.Append(s(i))
If s(i) = "'" Then DataString.Append("'")
Next
DataString.Append("'")
Case 72 'guid
DataString.Append(Dr)
Case 11 'bit
DataString.Append("'")
If Dr = "0" Then
DataString.Append("False")
ElseIf Dr = "-1" Then
DataString.Append("True")
Else
DataString.Append(Dr)
End If
DataString.Append("'")
Case 32768 'uniqueidentifier it should never come here
DataString.Append(Dr)
Case 32771 'blob
DataString.Append(Dr)
Case 128
DataString.Append("decode('")
DataString.Append(Convert.ToBase64String(Dr))
DataString.Append("','base64')")
Case Else
Throw New InvalidConstraintException("Type ID=" & dt & " Not Recognized")
End Select
Return DataString.ToString
End Function
Public ReadOnly Property Databases As ArrayList Implements XToY.Databases
Get
Return Me.p_Database
End Get
End Property
Public Property Database As String Implements XToY.Database
Get
Return ""
End Get
Set(val As String)
End Set
End Property
Public Sub AddQueries(qryName As String, qryDefinition As String) Implements XToY.AddQueries
Dim odr As New OleDb.OleDbDataAdapter(qryDefinition, o)
Dim tbl As New DBTable
tbl.Name = qryName
tbl.IsQuery = True
tbl.QueryString = qryDefinition
tbl.DBTarget = "Postgres"
odr.Fill(tbl.Datatable)
tbl.TranslateToTable()
For i As Integer = 0 To tbl.Columns.Count - 1
tbl.Columns(i).NewName = QuoteName(tbl.Columns(i).Name)
Next
odr.Dispose()
h_TAbles.Add(qryName, tbl)
End Sub
Public Property Schema As String Implements XToY.Schema
Get
Return ""
End Get
Set(value As String)
End Set
End Property
Public ReadOnly Property schemas As ArrayList Implements XToY.Schemas
Get
Dim i As New ArrayList
Return i
End Get
End Property
Private Function QuoteName(ByVal st As String) As String
Dim cha() As Char = {"'", Chr(34), " ", "$", "`"}
st = st.Trim(cha)
st = st.Replace("/", "_").Replace("\", "_").Replace(".", "_")
Return Quoter.QuoteNamePG(st, UseQuotes)
End Function
Private Function EscapeName(ByVal st As String) As String
Dim s As New System.Text.StringBuilder
Dim cha() As Char = {"'", Chr(34), " ", "$", "`"}
st = st.Trim(cha)
st = st.Replace("/", "_").Replace("\", "_").Replace(".", "_")
For i As Integer = 0 To st.Length - 1
s.Append(st(i))
If st(i) = "'" Then s.Append("'")
Next
Return s.ToString
End Function
End Class
IT-сервер поставляется с программой, поэтому игнорируйте инструменты. Есть две точки доступа New, которые открывают соединение и загружают схемы таблицы. Другой - это Execute(), которые создают инструкции SQL. то, что вам нужно ...
Значения всех одинакового типа? Если, например, ado обнаруживает, что столбец является числовым и чем найденные строки, он не будет импортировать эти строки. – jurhas
Дорогой, все строки импортируются, но некоторые строки не являются импортными д. Есть ли в столбце описания этот тип данных (от 4,5 до 2 7/8 ")? Пожалуйста, помогите по этому поводу. – user3069097
Я объяснил это плохо. Он импортирует все, но если у них нет одинакового типа данных, он будет NULL. Если у вас есть столбец (2,3,4,4/5 ", 5), он будет импортировать (2,3,4, NULL, 5), потому что он обнаружил, что столбец является числовым, но литой 4/5 «это не будет достигнуто. – jurhas