Excelden MSSQL’e veri yazma

Aşağıda örnek kodlar var. İncelenirse anlaşılacak mahiyette.


Sub sqlaktarim()

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnectionString As String
Dim strInsert As String
Dim ws As Worksheet
Dim son As Integer
Dim sonn As Integer
Dim kntrl As Boolean

Set ws = Sheets("DEPO")
Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection
son = ws.Cells(Rows.Count, 1).End(xlUp).Row

strConnectionString = "Provider=SQLOLEDB;Data Source=...........\SQLEXPRESS;Initial Catalog=uretim;User ID=sa;Password=............. ;"

For j = 2 To son

On Error GoTo ErrorHandler
cnn.ConnectionTimeout = 1
cnn.CommandTimeout = 0
cnn.Open strConnectionString
rs.Open "SELECT distinct ProfNo FROM [uretim].[dbo].[ProformaVerileri] where ProfNo='" & ws.Range("j" & j) & "'", cnn
kntrl = rs.BOF

If kntrl = True Then
cnn.Close
sonn = WorksheetFunction.CountIf(ws.Range("j:j"), ws.Range("j" & j))
For i = j To sonn + j - 1

cnn.Open strConnectionString

strInsert = "insert into ProformaVerileri ([TeklifTarihi],[Firma],[Banka],[OdemeSekli],[ParaBirimi],[FaturaNo],[TeklifVeren],[TeslimSekli],[ProfNo],[SabitIskonto],[EkIskonto],[Tip]" & _
",[Izo],[Cap],[Miktar],[Boy],[Koli],[AdımBR],[AdımCK],[Iskonto],[OzelFiyat],[TL$€/m],[TL$€/kutu],[TL$€],[TL$€/kutuG],[TL$€G],[Nakliye],[Masraf],[SonIskonto]" & _
",[Hacim],[SatisIndeks],[TL$€/kg],[SatisIndeksTotal],[TL$€/kgTotal])" & _
"values ('" & WorksheetFunction.Text(ws.Range("B" & i).Value, "yyyy-mm-dd HH:dd:ss") & "'," & _
"'" & ws.Range("c" & i).Value & "'," & "'" & ws.Range("d" & i).Value & "'," & "'" & ws.Range("e" & i).Value & "'," & _
"'" & ws.Range("f" & i).Value & "'," & "'" & ws.Range("g" & i).Value & "'," & "'" & ws.Range("h" & i).Value & "'," & _
"'" & Replace(ws.Range("ı" & i).Value, ",", "") & "'," & "'" & Replace(ws.Range("j" & i).Value, ",", ".") & "'," & "'" & Replace(ws.Range("k" & i).Value, ",", ".") & "'," & _
"'" & ws.Range("l" & i).Value & "'," & "'" & ws.Range("m" & i).Value & "'," & "'" & ws.Range("n" & i).Value & "'," & _
"'" & ws.Range("o" & i).Value & "'," & "'" & ws.Range("p" & i).Value & "'," & "'" & ws.Range("q" & i).Value & "'," & _
"'" & ws.Range("r" & i).Value & "'," & "'" & ws.Range("s" & i).Value & "'," & "'" & ws.Range("t" & i).Value & "'," & _
"'" & ws.Range("u" & i).Value & "'," & "'" & ws.Range("v" & i).Value & "'," & "'" & ws.Range("w" & i).Value & "'," & _
"'" & ws.Range("x" & i).Value & "'," & "'" & ws.Range("aa" & i).Value & "'," & "'" & ws.Range("ab" & i).Value & "'," & _
"'" & ws.Range("ac" & i).Value & "'," & "'" & ws.Range("ad" & i).Value & "'," & Replace(ws.Range("ae" & i).Value, ",", ".") & "," & _
"'" & ws.Range("af" & i).Value & "'," & "'" & ws.Range("ag" & i).Value & "'," & "'" & ws.Range("ah" & i).Value & "'," & _
"'" & Replace(ws.Range("aı" & i).Value, ",", ".") & "'," & "'" & Replace(ws.Range("aj" & i).Value, ",", ".") & "'," & "'" & ws.Range("ak" & i).Value & "')"

cnn.Execute (strInsert)

If cnn.State = 1 Then
cnn.Close
End If

Next

End If

If cnn.State = 1 Then
cnn.Close
End If

Next

ErrorHandler:
Exit Sub

End Sub

Not: ADODB.Connection ve ADODB.Recordset nesnelerini tanımlamak için Tools/References ‘ dan “Microsoft ActiveX Data Objects 2.0 Library” referansını projenize eklemeniz gerekir. Yoksa kodlar çalışmaz. 

Paylaşmayı unutmayın!