Function PrebaciPodatkeUExcel()

    ' Pristupi bazi podataka

   Dim db As DAO.Database

    Set db = CurrentDb

 

    ' Definisi SQL upit za selektovanje podataka iz Access tabele

   Dim strSQL As String

    strSQL = "SELECT * FROM ImetvojeTabeleuAccessu;"

 

    ' Otvara rekordset na osnovu SQL upita

   Dim rs As DAO.Recordset

    Set rs = db.OpenRecordset(strSQL)

 

    ' Kreira novi Excel aplikacija objekt

   Dim xlApp As Object

    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True ' Ako zelis vidjeti Excel aplikaciju

 

    ' Dodajte novi radni list u Excel

   Dim xlWb As Object

    Set xlWb = xlApp.Workbooks.Add

    Dim xlWs As Object

    Set xlWs = xlWb.Sheets(1) ' Prvi radni list u novom radnom svesku

 

    ' Postavi zaglavlje u Excel

   For i = 1 To rs.Fields.Count

        xlWs.Cells(1, i).Value = rs.Fields(i - 1).Name

    Next i

 

    ' Dodaj podatke u Excel

   Dim red As Integer

    red = 2 ' Prvi red sa podacima u Excel (iza zaglavlja)

 

    Do Until rs.EOF

        For i = 1 To rs.Fields.Count

            xlWs.Cells(red, i).Value = rs.Fields(i - 1).Value

        Next i

        rs.MoveNext

        red = red + 1

    Loop

 

    ' Zatvori rekordset i bazu podataka

   rs.Close

    Set rs = Nothing

    Set db = Nothing

End Function