kodlar;
Option Compare Database
Dim TabloAdi As String
Private Sub ListeyiYukle(KaynakAdi 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_Load()
ComboyuDoldur
End Sub
Private Sub Kaynaklar_AfterUpdate()
If Len(Kaynaklar.Text & "xx") <= 2 Then Exit Sub
ListeyiYukle Kaynaklar.Text
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