Option Compare Database
Dim TabloAdi As String
Private Sub ListeyiYukle(secımlıyukle As String) Dim s As String
 Dim I As Integer
 Dim SutunSay As Integer
 Dim lstItem As ListItem
 If Len(KaynakAdi & "xx") <= 2 Then Exit Sub
 TabloAdi = KaynakAdi
 s = "Select * from " & KaynakAdi
 If Not AdoAc1(s) Then
 MsgBox "Tablo/Sorgu açılamadı", vbInformation
 Exit Sub
 End If
 
 With ListView1
 .ListItems.Clear
 .ColumnHeaders.Clear
 .View = lvwReport
 .GridLines = True
 .FullRowSelect = True
 .Checkboxes = True
 .ColumnHeaders.Add , , "Alan", .Width - 200
 End With
 SutunSayisi = Rs1.Fields.Count - 1
 For I = 0 To SutunSayisi
 Set lstItem = ListView1.ListItems.Add()
 lstItem.Text = Nz(Rs1.Fields(I).Name, "-")
 Next
 AdoKapa 1
End Sub
Private Sub ComboyuDoldur()
 Dim obj As AccessObject, dbs As Object
 Set dbs = Application.CurrentData
 Dim s As String
 'Önce tabloları al
 For Each obj In dbs.AllTables
 If Left(obj.Name, 4) <> "mSys" Then s = s & obj.Name & ";"
 Next
 'Şimdi de sorguları
 For Each obj In dbs.AllQueries
 s = s & obj.Name & ";"
 Next
 If s <> "" Then Kaynaklar.RowSource = s
End Sub

Private Sub Form_Current()
DoCmd.Maximize
End Sub

Private Sub Form_Load()
 ComboyuDoldur
End Sub

Private Sub Kaynaklar_AfterUpdate()
 If Len(Kaynaklar.Text & "xx") <= 2 Then Exit Sub
 ListeyiYukle Kaynaklar.Text
End Sub

Private Sub Komut12_Click()
DoCmd.Close acForm, "SecimliYukle"
DoCmd.OpenForm "VAKA BİLGİLERİ", acNormal, "", "", , acNormal

End Sub

Private Sub Komut3_Click()
 Dim Item As ListItem
 Dim I As Long
 Dim mesaj As String
 Dim s As String
 mesaj = ""
 For I = 1 To Me.ListView1.ListItems.Count
 Set Item = Me.ListView1.ListItems.Item(I)
 If Item.Checked Then
 If Len(mesaj) = 0 Then mesaj = Item.Text Else mesaj = mesaj & "," & Item.Text
 End If
 Next
 If Len(mesaj) = 0 Then Exit Sub
 s = "select " & mesaj & " from " & TabloAdi
 AdoAcEx s
 ExAc
 KayittanExcele
End Sub