Dim dbs As DAO.Database

Dim rsSQL As DAO.Recordset

Dim strSQL As String

Dim xlApp As Excel.Application

Dim xlSh As Excel.Worksheet

Dim objWkb As Excel.Workbook

Dim i As Long



Set xlApp = New Excel.Application



With xlApp

            .Visible = True

            Set objWkb = .Workbooks.Add

            Set xlSh = objWkb.Worksheets(1)

            xlSh.Name = "İş listesi"

End With



xlApp.Visible = True

xlApp.ActiveWindow.WindowState = xlMaximized



xlSh.Cells(1, 2).value = "Tür"

xlSh.Cells(1, 3).value = "Konu1"

xlSh.Cells(1, 4).value = "Konu2"

xlSh.Cells(1, 5).value = "Mevcut Durum"

xlSh.Cells(1, 6).value = "Açıklama"





Set dbs = CurrentDb

strSQL = "SELECT * FROM srg_plan"

Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenSnapshot)



If rsSQL.RecordCount > 0 Then

rsSQL.MoveFirst

rsSQL.MoveLast

End If





rsSQL.MoveFirst

If rsSQL.RecordCount > 0 Then

For i = 0 To rsSQL.RecordCount - 1







xlSh.Cells(GSayi + i + 1, 2).value = rsSQL!tur

xlSh.Cells(GSayi + i + 1, 3).value = rsSQL!konu1

xlSh.Cells(GSayi + i + 1, 4).value = rsSQL!konu2

xlSh.Cells(GSayi + i + 1, 5).value = rsSQL!mevcutdurum

xlSh.Cells(GSayi + i + 1, 6).value = rsSQL!bildirimaciklama



rsSQL.MoveNext

Next i

End If







rsSQL.Close

Set rsSQL = Nothing

Şeklinde kod kullanılabilir, ancak @berduşun da belirttiği gibi istenilen alanları içeren sorgu oluşturulup excele aktarmak daha mantıklı.