'
' Deklaration der DB-Objektvarialen
 
' Connection-Objekt
Dim oConn As ADODB.Connection
 
' Instanzierung des Objekts
Set oConn = New ADODB.Connection
 
' Recordset-Objekt
Dim oRS As Recordset
 
' Recordset erstellen
Set oRS = New ADODB.Recordset
 
' Öffnen der ODBC Schnittstelle
' DSN ist der DataSourceName
oConn.Open "Provider=MSDASQL;DSN=myODBC_user"
 
' eine Abfrage erstellen...
 
oRS.Open "SELECT fusion_awtz_order_0.order_nr," & _
  "fusion_awtz_order_0.customer_name, fusion_awtz_costitem_0.costitem_nr," & _
  "fusion_awtz_costitem_0.costitem_desc, fusion_awtz_costitem_0.costitem_price," & _
  "fusion_awtz_extra_costs_0.extra_id, fusion_awtz_extra_costs_0.extra_desc," & _
  "fusion_awtz_extra_costs_0.extra_price," & _
  "fusion_awtz_ticket_citem_0.citem_duration," & _
  "fusion_awtz_section_0.section_name  FROM hundd.fusion_awtz_costitem" & _
  "fusion_awtz_costitem_0, hundd.fusion_awtz_extra_costs" & _
  "fusion_awtz_extra_costs_0, hundd.fusion_awtz_order fusion_awtz_order_0," & _
  "hundd.fusion_awtz_section fusion_awtz_section_0," & _
  "hundd.fusion_awtz_ticket_citem fusion_awtz_ticket_citem_0  WHERE" & _
  "fusion_awtz_extra_costs_0.order_id = fusion_awtz_order_0.order_id AND" & _
  "fusion_awtz_section_0.section_id = fusion_awtz_costitem_0.section_id AND" & _
  "fusion_awtz_ticket_citem_0.costitem_id = fusion_awtz_costitem_0.costitem_id" & _
  "AND fusion_awtz_ticket_citem_0.order_id = fusion_awtz_order_0.order_id AND ((" & _
  "fusion_awtz_order_0.order_nr='A005700'))", oConn
 
 
    Recordset2Excel oRS
 
oRS.Close
 
End Sub
 
 
Public Sub Recordset2Excel(rstSource As ADODB.Recordset)
    Dim xlsApp As Excel.Application
    Dim xlsWBook As Excel.Workbook
    Dim xlsWSheet As Excel.Worksheet
    Dim i, j As Long
 
    ' Get or Create Excel Object
    On Error Resume Next
    Set xlsApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set xlsApp = New Excel.Application
            Err.Clear
    End If
 
    ' Create WorkSheet
    Set xlsWBook = xlsApp.Workbooks.Add
    Set xlsWSheet = xlsWBook.ActiveSheet
 
    ' Export ColumnHeaders
    For j = 0 To rstSource.Fields.Count
        xlsWSheet.Cells(1, j + 1) = rstSource.Fields(j).Name
    Next j
 
    xlsWSheet.Cells(2, 1).CopyFromRecordset rstSource
    xlsWSheet.SaveAs App.Path & "\Export\Expt " & Format(Date, "MMDDYYYY") & _
      "_" & Format(Time, "HHnSS") & ".xls"
 
    Set xlsApp = Nothing
    Set xlsWBook = Nothing
    Set xlsWSheet = Nothing
    MsgBox "Export Successfull.", vbOKOnly, "Export"
End Sub