bulentkars
Altın Üye
- Katılım
- 5 Ağustos 2005
- Mesajlar
- 671
- Excel Vers. ve Dili
- 2003 TR
- Altın Üyelik Bitiş Tarihi
- 23-03-2027
Arkadaşlar Merhaba,
ADO yöntemi ile dışarıdaki çalışma kitabına kayıt yapıyorum, ancak bazı sütünları metin olarak kaydediyor, ekte resim olarak ta gösterdim. Kodun içerisinde de belirttim, aşağıdaki 3 sutun başlığının metin olarak değil sayı olarak kaydetmesini istiyorum, yardımcı olabilirseniz sevinirim. Şimdiden Teşekkürler
Alan4 = Range("B6").Value ' BU ALAN
Alan8 = Range("B10").Value ' BU ALAN
Alan10 = Range("B12").Value ' BU ALAN
Sub Kaydet()
Dim adoCN As Object, TargetFile As String, strSQL As String, objRS As Object, i As Integer, tStart As Double
Const adOpenStatic = 3
Const adUseClient = 3
Const adLockBatchOptimistic = 4
DosyaAdi = Range("B4").Value & ".xlsb"
Alan1 = Range("B3").Value
Alan2 = Range("B4").Value
Alan3 = Range("B5").Value
Alan4 = Range("B6").Value ' BU ALAN
Alan5 = Range("B7").Value
Alan6 = Range("B8").Value
Alan7 = Range("B9").Value
Alan8 = Range("B10").Value ' BU ALAN
Alan9 = Range("B11").Value
Alan10 = Range("B12").Value ' BU ALAN
tStart = Timer
Set adoCN = CreateObject("ADODB.Connection")
TargetFile = "Z:\Şahin\Database\" & DosyaAdi
adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
adoCN.Properties("Data Source") = TargetFile
adoCN.Properties("Extended Properties") = "Excel 12.0; HDR=No"
adoCN.Open
Set objRS = CreateObject("ADODB.Recordset")
strSQL = "Select Count(*) From [Data$] Where F1 Is Not Null"
With objRS
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.ActiveConnection = adoCN
.Source = strSQL
.Open
End With
i = objRS(0)
strSQL = "Insert Into [Data$" & "A" & i & ":M" & i & "] (F1, F2, F3, F4, F5, F6, F7, F8, F9, F10) " & _
"Values " & _
"('" & Alan1 & "','" & Alan2 & "','" & Alan3 & " ','" & Alan4 & "'," & _
"'" & Alan5 & "','" & Alan6 & "','" & Alan7 & " ','" & Alan8 & "'," & _
"'" & Alan9 & "','" & Alan10 & "')"
adoCN.Execute strSQL
MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - tStart, "0.00") & " Saniye", vbInformation, Application.UserName
adoCN.Close
Set adoCN = Nothing
End Sub
ADO yöntemi ile dışarıdaki çalışma kitabına kayıt yapıyorum, ancak bazı sütünları metin olarak kaydediyor, ekte resim olarak ta gösterdim. Kodun içerisinde de belirttim, aşağıdaki 3 sutun başlığının metin olarak değil sayı olarak kaydetmesini istiyorum, yardımcı olabilirseniz sevinirim. Şimdiden Teşekkürler
Alan4 = Range("B6").Value ' BU ALAN
Alan8 = Range("B10").Value ' BU ALAN
Alan10 = Range("B12").Value ' BU ALAN
Sub Kaydet()
Dim adoCN As Object, TargetFile As String, strSQL As String, objRS As Object, i As Integer, tStart As Double
Const adOpenStatic = 3
Const adUseClient = 3
Const adLockBatchOptimistic = 4
DosyaAdi = Range("B4").Value & ".xlsb"
Alan1 = Range("B3").Value
Alan2 = Range("B4").Value
Alan3 = Range("B5").Value
Alan4 = Range("B6").Value ' BU ALAN
Alan5 = Range("B7").Value
Alan6 = Range("B8").Value
Alan7 = Range("B9").Value
Alan8 = Range("B10").Value ' BU ALAN
Alan9 = Range("B11").Value
Alan10 = Range("B12").Value ' BU ALAN
tStart = Timer
Set adoCN = CreateObject("ADODB.Connection")
TargetFile = "Z:\Şahin\Database\" & DosyaAdi
adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
adoCN.Properties("Data Source") = TargetFile
adoCN.Properties("Extended Properties") = "Excel 12.0; HDR=No"
adoCN.Open
Set objRS = CreateObject("ADODB.Recordset")
strSQL = "Select Count(*) From [Data$] Where F1 Is Not Null"
With objRS
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.ActiveConnection = adoCN
.Source = strSQL
.Open
End With
i = objRS(0)
strSQL = "Insert Into [Data$" & "A" & i & ":M" & i & "] (F1, F2, F3, F4, F5, F6, F7, F8, F9, F10) " & _
"Values " & _
"('" & Alan1 & "','" & Alan2 & "','" & Alan3 & " ','" & Alan4 & "'," & _
"'" & Alan5 & "','" & Alan6 & "','" & Alan7 & " ','" & Alan8 & "'," & _
"'" & Alan9 & "','" & Alan10 & "')"
adoCN.Execute strSQL
MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - tStart, "0.00") & " Saniye", vbInformation, Application.UserName
adoCN.Close
Set adoCN = Nothing
End Sub
Ekli dosyalar
-
94 KB Görüntüleme: 8