Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Şubat 2007 Salı

Excel - Access Connection And DataBase Relations








'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Visual Basic For Applications
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'Microsoft Forms 2.0 Object Library
'Microsoft DAO 3.6 Object Library.
'Microsoft ActiveX Data Objects 2.8 Object Library.
'Microsoft ADO Ext. 2.8 For DDL and Security
'Microsoft Office Web Components 11.0
'B) UserForm1 E Eklenen Araçlar (Add Tools)
'Frama1
'Frame1\Image1, Label1, Label2
'Label3, Label4, Label5, Label6
'TextBox1, TextBox2, TextBox3, TextBox4
'SpinButton1
Option Explicit
Dim No As Single, i As Single
Option Base 1
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String, HedefTablo As String, DosyaDeseni As String
Dim Satır As Integer, Kolon As Integer
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD ®] Excel - Access Connection And DataBase Relations"
Call EkranDüzenle
Call VeriTabanınıAç
No = 1
SpinButton1.Value = 1
Call KayıtGetir
End Sub
Private Sub SpinButton1_SpinDown()

On Error GoTo Hata
No = No - 1
Call KayıtGetir
Exit Sub
Hata:
End Sub
Private Sub SpinButton1_SpinUp()

On Error GoTo Hata
No = No + 1
Call KayıtGetir
Exit Sub
Hata:
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error Resume Next
CN.Close: Set CN = Nothing
Set Komut = Nothing
End
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 163.5
.Width = 339.75
.BackColor = &H8000000F
With Frame1
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
If .Picture = vbNull Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
If .Picture = vbNull Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
End With
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
With Label2
.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
End With
With Label3
.Caption = " " & "ID"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 42
.Height = 18
.Width = 66
.ForeColor = &H80000012
End With
With Label4
.Caption = " " & "ADI"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 60
.Height = 18
.Width = 66
.ForeColor = &H80000012
End With
With Label5
.Caption = " " & "SOYADI"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 78
.Height = 18
.Width = 66
.ForeColor = &H80000012
End With
With Label6
.Caption = " " & "DOĞUM TARİHİ"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 96
.Height = 18
.Width = 66
.ForeColor = &H80000012
End With
With TextBox1
.SpecialEffect = fmSpecialEffectEtched
.Left = 78
.Top = 42
.Height = 18
.Width = 36
.ForeColor = &H80000012
.Locked = True
End With
With TextBox2
.SpecialEffect = fmSpecialEffectEtched
.Left = 78
.Top = 60
.Height = 18
.Width = 246
.ForeColor = &HFF0000
End With
With TextBox3
.SpecialEffect = fmSpecialEffectEtched
.Left = 78
.Top = 78
.Height = 18
.Width = 246
.ForeColor = &HFF0000
End With
With TextBox4
.SpecialEffect = fmSpecialEffectEtched
.Left = 78
.Top = 96
.Height = 18
.Width = 66
.ForeColor = &HFF0000
End With
With SpinButton1
.Left = 6
.Top = 114
.Height = 18
.Width = 66
.Min = 1
.Max = 37000
End With
End With
End Sub
Sub VeriTabanınıAç()

On Error Resume Next
Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Devam1:
On Error GoTo Hata1
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
Devam2:
On Error GoTo Hata2
Set RS = New ADODB.Recordset
RS.Open Tablo, CN, adOpenStatic, adLockOptimistic, adCmdTable
Exit Sub
Hata1:
Call VeriTabanıYaratADO
Resume Devam1
Hata2:
Call KayıtTablosuDüzenlemek
ThisWorkbook.Sheets("Sayfa2").Select
Call ExceldenAccesseDAOVeriAl
Resume Devam2
End Sub
Sub KayıtGetir()

On Error GoTo Devam
Satır = No
With RS
.MoveFirst
For i = 1 To Satır - 1
.MoveNext
Next i
Devam:
On Error GoTo Hata
TextBox1.Text = RS.Fields("ID").Value
TextBox2.Text = RS.Fields("ADI").Value
TextBox3.Text = RS.Fields("SOYADI").Value
TextBox4.Text = RS.Fields("DTARIHI").Value
End With
Exit Sub
Hata:
End Sub

'Module1
Option Explicit
Dim Yol As String, Dosya As String
Dim Katalog As New ADOX.Catalog
Sub VeriTabanıYaratADO()
'Create Data Base

Yol = "C:\"
Dosya = "Örnek.mdb"
Katalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";" & ";Data Source = " & Yol & Dosya
Set Katalog = Nothing
Exit Sub
Hata:
MsgBox "Veri tabanıoluşturma hatası..." & Chr(10) & Chr(10) & "Hata No: " & Err & Chr(10) & "Hata Tanımı: " & VBA.Err.Description, vbExclamation, "[PBİD®]Create a Database by ADOX"
End Sub

'Module 2

'DataType property.


'Text1 = Text(Size)
'Text2 = CHAR(Size)
'Memo = MEMO
'Number:Byte= BYTE
'Number:Integer= SHORT
'Number:Long= LONG
'Number:Single= SINGLE
'Number:Double= DOUBLE
'Number:Replica= GUID
'Number:Decimal= DECIMAL (precision, scale)
'Date/Time= DATETIME
'Currency= CURRENCY
'Auto Number= COUNTER (seed, increment)
'Yes/No= YESNO
'OLE Object= LONGBINARY


Option Explicit
Dim CN As ADODB.Connection
Dim Komut As New ADODB.Command
Dim DosyaDeseni
Dim Yol As String, Dosya As String, Tablo As String
Sub KayıtTablosuDüzenlemek()
'Create Table

On Error GoTo Hata
Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
On Error GoTo Hata
DosyaDeseni = " CREATE TABLE " & Tablo _
& " (" _
& "ID COUNTER(1,1), " _
& "ADI TEXT(60), " _
& "SOYADI TEXT(60), " _
& "DTARIHI DATETIME" _
& ")"
Komut.CommandText = DosyaDeseni
Komut.ActiveConnection = CN
Komut.Execute
Set CN = Nothing
Set Komut = Nothing
Exit Sub
Hata:
Set CN = Nothing
Set Komut = Nothing
MsgBox "Kayıt Tablosu Düzenleme Hatası" & Chr(10) & Chr(10) & "Hata No: " & Err & Chr(10) & "Hata Tanımı: " & VBA.Err.Description, vbInformation, "[PBİD®]Kayıt Tablosu (Create Table)"
End Sub

'Module3

Option Explicit
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim Satır As Long
Dim Yol As String, Dosya As String, Tablo As String
Sub ExceldenAccesseDAOVeriAl()
'ExcelToAccessTransferByDAO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set DB = OpenDatabase(Yol & Dosya)
Set RS = DB.OpenRecordset(Tablo, dbOpenTable)
Satır = 2
Do While (VBA.Len(Range("A" & Satır).Formula) > 0)'VeriVarsa
With RS
.AddNew
.Fields("ID") = Range("A" & Satır).Value
.Fields("ADI") = Application.WorksheetFunction.Proper(Range("B" & Satır).Value)
.Fields("SOYADI") = VBA.UCase(Range("C" & Satır).Value)
.Fields("DTARIHI") = VBA.Format(VBA.CDate(Range("D" & Satır).Value), "dd.mm.yyyy")
.Update
End With
Satır = Satır + 1
Loop
RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing
End Sub
Sub AccesstenExceleDAOVeriAl()
'AccessToExcelTransferByDAO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set DB = OpenDatabase(Yol & Dosya)
Set RS = DB.OpenRecordset(Tablo, dbOpenTable)
Satır = 1
Do While RS.EOF = False
With RS
Cells(Satır, 1) = .Fields("ID")
Cells(Satır, 2) = Application.WorksheetFunction.Proper(.Fields("ADI"))
Cells(Satır, 3) = VBA.UCase(.Fields("SOYADI"))
Cells(Satır, 4) = VBA.Format(.Fields("DTARIHI"), "dd.mm.yyyy")
Satır = Satır + 1
.MoveNext
End With
Loop
RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing
End Sub

'Module4

Option Explicit
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Satır As Long
Dim Yol As String, Dosya As String, Tablo As String
Sub ExceldenAccesseADOVeriAl()
'ExcelToAccessTransferByADO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Yol & Dosya & ";"
Set RS = New ADODB.Recordset
RS.Open Tablo, CN, adOpenKeyset, adLockOptimistic, adCmdTable
Satır = 1
Do While (VBA.Len(Range("A" & Satır).Formula) > 0)'VeriVarsa
With RS
.AddNew
.Fields("ID") = Range("A" & Satır).Value
.Fields("ADI") = Application.WorksheetFunction.Proper(Range("B" & Satır).Value)
.Fields("SOYADI") = VBA.UCase(Range("C" & Satır).Value)
.Fields("DTARIHI") = VBA.Format(Range("D" & Satır).Value, "dd.mm.yyyy")
.Update
End With
Satır = Satır + 1
Loop
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing
End Sub
Sub AccesstenExceleADOVeriAl()
'AccessToExcelTransferByADO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Yol & Dosya & ";"
Set RS = New ADODB.Recordset
RS.Open Tablo, CN, adOpenKeyset, adLockOptimistic, adCmdTable
Satır = 1
Do While RS.EOF = False
With RS
Range("A" & Satır).Value = .Fields("ID")
Range("B" & Satır).Value = Application.WorksheetFunction.Proper(.Fields("ADI"))
Range("C" & Satır).Value = VBA.UCase(.Fields("SOYADI"))
Range("D" & Satır).Value = VBA.Format(.Fields("DTARIHI"), "dd.mm.yyyy")
.MoveNext
End With
Satır = Satır + 1
Loop
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing
End Sub

'Module5

References Description= Microsoft DAO x.xx Object Library.
Option Explicit
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim Satır As Long, Kolon As Long
Dim Yol As String, Dosya As String, Tablo As String
Dim HedefAlan As Range
Sub AccesstenExceleDAOTümVeriAl()
'AccessToExcelAllTransferByDAO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set HedefAlan = ThisWorkbook.Sheets("Sayfa1").Cells(1, 1)
Set DB = OpenDatabase(Yol & Dosya)
Set RS = DB.OpenRecordset(Tablo, dbOpenTable) 'All records
For Kolon = 0 To RS.Fields.Count - 1
HedefAlan.Offset(0, Kolon).Value = RS.Fields(Kolon).Name
Next
HedefAlan.Offset(1, 0).CopyFromRecordset RS
RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing
End Sub
Sub AccesstenExceleDAOTekVeriAl() '
AccessToExcelSingleTransferByDAO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set HedefAlan = ThisWorkbook.Sheets("Sayfa1").Cells(1, 1)
Set DB = OpenDatabase(Yol & Dosya)
Set RS = DB.OpenRecordset(Tablo, dbOpenTable) 'All records
Satır = 0
With RS
If Not .BOF Then .MoveFirst
While .EOF = False
HedefAlan.Offset(Satır, 0).Formula = .Fields("ADI")
.MoveNext
Satır = Satır + 1
Wend
End With
RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing
End Sub

'Module6
Option Explicit
Dim i As Single
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Satır As Integer, Kolon As Integer
Dim Yol As String, Dosya As String, Tablo As String
Dim HedefAlan As Range
Sub AccesstenExceleADOTümVeriAl()
'AccessToExcelAllTransferByADO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set HedefAlan = ThisWorkbook.Sheets("Sayfa1").Cells(1, 1)
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Yol & Dosya & ";"
Set RS = New ADODB.Recordset
With RS
.Open Tablo, CN, adOpenStatic, adLockOptimistic, adCmdTable
For Kolon = 0 To RS.Fields.Count - 1 'Fields Name
HedefAlan.Offset(0, Kolon).Value = RS.Fields(Kolon).Name
Next
HedefAlan.Offset(1, 0).CopyFromRecordset RS
End With
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing
End Sub
Sub AccesstenExceleADOTekVeriAl()
'AccessToExcelSingleTransferByADO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Satır = 1
Set HedefAlan = ThisWorkbook.Sheets("Sayfa1").Cells(1, 1)
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Yol & Dosya & ";"
Set RS = New ADODB.Recordset
With RS
.Open Tablo, CN, adOpenStatic, adLockOptimistic, adCmdTable
.MoveFirst
For i = 1 To Satır
.MoveNext
Next i
For Kolon = 0 To RS.Fields.Count - 1 'Fields Name
HedefAlan.Offset(0, Kolon).Value = RS.Fields(Kolon).Name
HedefAlan.Offset(1, Kolon).Value = RS(Kolon)
Next
End With
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing
End Sub

'Module7

Option Explicit
Dim Yol As String, Dosya As String
Sub VeriTabanıSil()
'Delete Data Base

Yol = "C:\"
Dosya = "Örnek.mdb"
VeriTabanıSilmek Yol & Dosya, 1
End Sub
Function VeriTabanıSilmek(ByVal VeriTabanıAdı$, İşaret)
'Delete Data Base Function

On Error Resume Next
If İşaret = 0 Then GoTo İptal
If vbYes = MsgBox(Yol & Dosya & " Access veri tabanını silmek istediğinizden emin misiniz?", vbCritical + vbYesNo, "[PBİD®]Delete Access DataBase : " & VeriTabanıAdı) Then
GoTo İptal
Else
VeriTabanıSilmek = 0
End If
Exit Function
İptal:
VBA.Kill VeriTabanıAdı
VeriTabanıSilmek = 1
End Function

'Module8

Option Explicit
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command
Sub KayıtTablosunuSil()
'Delete Table

On Error GoTo Hata
Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
İlişki = " DROP TABLE " & Tablo
Komut.CommandText = İlişki
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
Komut.ActiveConnection = CN
Komut.Execute
Durak:
Set RS = Nothing
Set Komut = Nothing
Exit Sub
Hata:
MsgBox "Kayıt tablosu Silme Hatası oluştu..." & Chr(10) & Chr(10) & "Hata No: " & VBA.Err.Number & Chr(10) & "Hata Tanımı: " & VBA.Err.Description, vbInformation, "[PBİD®] Delete Record Set"
Resume Durak
End Sub

'Module9

Option Explicit
Option Base 1
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command
Sub AccesstenKayıtGetir()
'SelectAndReturnRecordsADO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
Set RS = New ADODB.Recordset
Set RS.ActiveConnection = CN
Set Komut = New ADODB.Command
Set Komut.ActiveConnection = CN
With Komut
.CommandText = " SELECT * " & " FROM " & Tablo & " WHERE ID Like '1%'"
.CommandType = adCmdText '1
.Execute
End With
RS.Open Komut
With ThisWorkbook.Sheets("Sayfa3")
With .Cells(1, 1)
.CurrentRegion.Clear
.Cells(1, 1) = .CopyFromRecordset(RS)

End With
End With
CN.Close: Set CN = Nothing
Set Komut = Nothing
Set RS = Nothing
End Sub

'Module10
Option Explicit
Option Base 1
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command
Sub AccesseKayıtGönder()
'UpdateSomeRecordsADODB

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
Set Komut = New ADODB.Command
Set Komut.ActiveConnection = CN
İlişki = ""
İlişki = İlişki & " UPDATE " & Tablo
İlişki = İlişki & " SET ADI= 'Eflatun'"
İlişki = İlişki & " WHERE ID=6"
With Komut
.CommandText = İlişki
.CommandType = adCmdText
.Execute
End With
CN.Close: Set CN = Nothing
Set Komut = Nothing
End Sub

'Module11

Option Explicit
Option Base 1
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command
Sub AccessteKayıtSil()
'DeleteSomeRecordsADO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
Set Komut = New ADODB.Command
Set Komut.ActiveConnection = CN
With Komut
.CommandText = " DELETE * " & " FROM " & Tablo & " WHERE ADI='Eflatun'"
.CommandType = adCmdText
.Execute
End With
CN.Close: Set CN = Nothing
Set Komut = Nothing
End Sub

'Module12
Option Explicit
Option Base 1
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command
Sub AccessteKayıtlarıSil()
'DeleteRecordsADO

Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
Set Komut = New ADODB.Command
Set Komut.ActiveConnection = CN
With Komut
.CommandText = " DELETE *" & " FROM " & Tablo
.CommandType = adCmdText
.Execute
End With
CN.Close: Set CN = Nothing
Set Komut = Nothing
End Sub

'Module13
Option Explicit
Option Base 1
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String, HedefTablo As String, DosyaDeseni As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command
Sub AccessteTablodanTabloyaVeriAktarmak1()


End Sub


'Module14

Option Explicit
Option Base 1
Dim Yol As String, Dosya As String, Tablo As String, İlişki As String, HedefTablo As String, DosyaDeseni As String
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim Komut As New ADODB.Command

Sub AccessteTablodanTabloyaVeriAktarmak2() 'CreateAnAccessTableFromAnExistingAccessTableADO
Yol = "C:\"
Dosya = "Örnek.mdb"
Tablo = "Tablo1"
HedefTablo = "Tablo2"
Set CN = New ADODB.Connection
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Yol & Dosya & ";"
DosyaDeseni = " CREATE TABLE " & HedefTablo _
& " (" _
& "ID COUNTER(1,1), " _
& "ADI TEXT(60), " _
& "SOYADI TEXT(60), " _
& "DTARIHI DATETIME" _
& ")"
Komut.CommandText = DosyaDeseni
Komut.ActiveConnection = CN
Komut.Execute
Set Komut = New ADODB.Command
Set Komut.ActiveConnection = CN
İlişki = ""
İlişki = İlişki & " DROP TABLE " & HedefTablo
With Komut
.CommandText = İlişki
.CommandType = adCmdText
.Execute
End With
İlişki = ""
İlişki = İlişki & " SELECT " & Tablo & ".* INTO " & HedefTablo
İlişki = İlişki & " FROM " & Tablo
With Komut
.CommandText = İlişki
.CommandType = adCmdText
.Execute
End With
CN.Close: Set CN = Nothing
Set Komut = Nothing
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul