VBA 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. 

Kolay gele…

İlk Yorumu Siz Yapın

Bir yanıt yazın

E-posta adresiniz yayınlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir