Visning af tabeller og forespørgsler i Excel (fra Access)

Det gælder i øvrigt Access 2002 og op

Denne åbner en foruddefineret Excel-fil:

Dim xls As New Excel.Application
'Gør Excel synlig
xls.Visible = True
xls.Workbooks.Open Filename:="D:\VBA\XP\Mappe1.xls"
'Lukker Access
DoCmd.Quit

Jeg har selv brugt følgende:

Private Sub ExportData2_Click()
On Error GoTo Err_ExportData2_Click
' Export Non-Dry Analyses Data to Excel

    ' Confirm Desire to Export
    Msg = "Do you want to export data to Excel?"
    Style = vbYesNo + vbExclamation + vbDefaultButton1
    Title = "Export Data"
    Response = MsgBox(Msg, Style, Title)
    If Response = vbNo Then GoTo Exit_ExportData2_Click

    strSQL = "SELECT * FROM [Chemical Analysis 2] WHERE RawMaterialName = '" & Me.RawMaterialName & "' ORDER BY TestDate DESC"
    Set qdf = CurrentDb.CreateQueryDef("ExcelExport", strSQL)  ' Define and Creat a Query
    ExportToExcel CurrentDb.QueryDefs("ExcelExport").SQL        ' Initiate ExportToExcel Function
    DoCmd.DeleteObject acQuery, "ExcelExport"                  ' Delete Query
   
Exit_ExportData2_Click:
    Exit Sub

Err_ExportData2_Click:
    MsgBox Err.Description
    Resume Exit_ExportData2_Click
   
End Sub

Public Function ExportToExcel(strSQL As String)
On Error GoTo Err_ExportToExcel
' Export Data to Excel Based on Previously Defined Query

    Screen.MousePointer = 11        ' Set Cursor Type to 'Busy' (hourglass)

    ' Prepare Excel Sheet
    Dim Exl As New Excel.Application
    Dim WrkBook As Excel.Workbook
    Dim rs As DAO.Recordset
    Dim i As Integer, j As Integer

    Set WrkBook = Exl.Workbooks.Add
    Set rs = CurrentDb.OpenRecordset(strSQL)    ' Open Database Recordset

    If rs.EOF And rs.BOF Then GoTo Exit_ExportToExcel
    rs.MoveLast
    rs.MoveFirst                                ' Set Pointer at Start of Recordset
   
    ' Insert Default Field Names in Excel and Define Column Width
    For j = 1 To rs.Fields.Count - 1
        WrkBook.Sheets(1).Cells(1, j).Value = rs.Fields(j).Name
        strVAR = Len(rs.Fields(j).Name) + 2
        If strVAR < 6 Then
            strVAR = 6
        End If
        WrkBook.Sheets(1).Cells(1, j).ColumnWidth = strVAR
    Next j
        WrkBook.Sheets(1).Cells(1, 1).ColumnWidth = strVAR + 10
   
    ' Export Recordset Data to Excel Row by Row
    For i = 1 To rs.RecordCount
      For j = 1 To rs.Fields.Count - 1
        WrkBook.Sheets(1).Cells(i + 2, j).Value = rs.Fields(j)
      Next j
      rs.MoveNext
    Next i
    WrkBook.Sheets(1).Columns(4).NumberFormat = "dd/mm/yyyy" ' Predefine Date-Column Format
    Exl.Visible = True  ' Open Excel Sheet

    ' Clean Up
    rs.Close
    Set rs = Nothing
    Set WrkBook = Nothing
    Set Exl = Nothing

Exit_ExportToExcel:
    Screen.MousePointer = 0    ' Set Cursor to 'Normal' Format
    Exit Function

Err_ExportToExcel:
    MsgBox Err.Description
    Resume Exit_ExportToExcel

End Function

Det lyder umiddelbart meget fornuftigt mugs, men hvis en bruger åbner rapporten 2 gange vil han så ikke blive bedt om at overskrive den "gamle" fil?

Jeg ville helst uden om temp filer, men det bliver vist svært.

Du kan bare ta hva du ka bruge c",)
Husk reference til Microsoft Excel xx.x Object Library

jklln > koden åbner kun filen, men tager ikke hensyn til om du har eksporteret. Du skal nok se lidt på hubs kode.

jeg har selv kode der eksporterer, men skal bare lige sikre mig at evt. filer der i forvejen ligger der, bliver overskrevet.

hubs kode er lidt for omstændig men det kan da også ske jeg kan optimere lidt på den ;-)

Private Sub XX_Click()
Dim xls As New Excel.Application

'Danner eksportfil
DoCmd.TransferSpreadsheet acExport, 8, "Systemrapport", "C:\Mappe1.xls", True
'Gør Excel synlig
xls.Visible = True
xls.Workbooks.Open FileName:="C:\Mappe1.xls"

Her er den færdige version af koden, men jeg har stadig et lille problem.

Jeg vil gerne have mappe1 som en temp fil, men når ejg sætter alle mine rapporter til at skrive til denne fil, laver de bare en ny fane i filen, i stedet for at overskrive den.

Er ikke sikker men hvis data alligvel bare skal overskrives, kan du så ikke bare delete arket først?

Altså noget i retning af "WrkBook.Sheets(1).Delete"

Kan du få det til at virke? Ellers må du lige sige til c",)