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ı.