Daten nach Excel exportieren

[AlexandersBär]

Hallo Leute

Ich habe mal wieder ein "kleineres" Problem mit meinem zu erstellenden Prog.

Ich soll eine Liste ausgeben welche mir die Projekte zu einem Kunden zuordnet.

Diese Liste stellt nicht das allzu große Problem dar, nur sollen anschließend all diese ermittelten Daten auch noch zur statistischen Auswertung nach Excel exportiert werden und das alles soll auf einen Mausklick hinpassieren.

Also es geht um den Excelexport, kennt sich damit jemand aus? Es handelt sich dabei übrigens um ein VB6 Programm!!

:confused:

[Jay Peg]

das geht ganz einfach...

Via OLE-Automation eine Sitzung EXCEL öffnen! wie das in VB geht kann ich dir nicht sagen, müsste aber leicht herauszufinden sein... (Vielleicht mit CREATEOBJECT(....)) Dann kannst Du ja für alles was du in Excel mit deinen Daten machen musst ein Makro aufzeichnen! Dieses Makro kannst Du Dir dann wiederum im EXCEL-internen VB-Editor anschauen! Dann hast Du sogar schon deinen Code!

Vielleicht hilft´s weiter!

[cindyhun]

Du hast ein Formular namens FrmHaupt, mit einen Button, das Exportiert (das Modul HauptExpXLS aufruft)

Projekt - Verweise:

1.Microsoft ActiveX Data Objects 2.5 Library

2.Microsoft Excel 9.0 Object Library

3.Microsoft Scripting Runtime

Projekt - Komponente:

1.Microsoft Common Dialog Control 6.0 (SP3)

2.Microsoft Windows Common Controls 6.0

Das Formular FrmHaupt enthält ein Common Dial. Ctrl namens 'CmnDialogCtrl'

Modul HauptExpXLS:

Option Explicit

Private mXLSRouteStr As String

Private mFSOObj As Scripting.FileSystemObj

Private mXLSAppObj As Excel.Application

Public Sub CreateXLS()

Dim tmpWrk As Excel.Workbook

Dim i As Integer

Dim tmpFilenameStr As String

Dim VollstNameStr As String

Dim FilePathStr As String

Dim variable1, variable2, variable3, variable4

On Error GoTo ErrCatch

Screen.MousePointer = vbHourglass

Set mXLSAppObj = New Application

Set gFSOObj = New FileSystemObject

' File path

mXLSRouteStr = App.Path

' File name

tmpFilenameStr = "ExportDaten.xls"

'********************************************************************

'Common Dialog Element von den Formular

'kannst evtl. weglassen. Das Dialog fragt, wo du den xls speichern

'möchtest. Kannst auch direkt angeben.

With FrmHaupt.CmnDialogCtrl

'"resume next" ist wegen Abbrechen wichtig!!!

On Error Resume Next

.FileName = tmpFilenameStr

.InitDir = mXLSRouteStr

.DialogTitle = "Exceltabelle Speichern"

'activate Cancel

.CancelError = True

.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist + cdlOFNNoReadOnlyReturn

.Filter = "(*.xls)|*.xls"

.ShowSave

'Error 32755 ist das Abbrechen Button

If Err.Number = 32755 Then

GoTo ExitProcedure

End If

FilePathStr = .FileName

End With

Screen.MousePointer = vbHourglass

'********************************************************************

On Error GoTo ErrCatch

Screen.MousePointer = vbHourglass

'Template / Vorlage für die Exceltabelle

Set tmpWrk = mXLSAppObj.Workbooks.Add("e:\ExpTemplate.xls")

'z.B. : Datum in Zelle B1

tmpWrk.Worksheets(1).Range("B1").Value = FormatDateTime(Date, vbShortDate)

'z.B. : Name in Zelle C1

tmpWrk.Worksheets(1).Range("C1").Value = "Cindy the Great"

'woher kommen deine Daten? Aus einer Datei?

Open "e:\ProjDaten.txt" For Input As #1

i = 2

Do While Not EOF(1)

Input #1, variable1, variable2, variable3, variable4

'Füllt eine Zeile

tmpWrk.Worksheets(1).Range("A" & i).Value = variable1

tmpWrk.Worksheets(1).Range("B" & i).Value = variable2

tmpWrk.Worksheets(1).Range("C" & i).Value = variable3

tmpWrk.Worksheets(1).Range("D" & i).Value = variable4

i = i + 1

Loop

Close #1

'wenn unter diesen Namen eine Datei schon existiert, _

dann löschen, damit keine Meldungen von Excel kommen

If mFSOObj.FileExists(FilePathStr) Then

mFSOObj.DeleteFile (FilePathStr)

End If

tmpWrk.SaveAs FilePathStr

ExitProcedure:

On Error Resume Next

Screen.MousePointer = vbDefault

tmpWrk.Close

mXLSAppObj.Quit

Set mFSOObj = Nothing

Set mXLSAppObj = Nothing

Exit Sub

ErrCatch:

Call MsgBox(CStr(Err.Number) & ":" & vbCrLf & Err.Description, vbOKOnly + vbCritical, "Error")

Resume ExitProcedure

Resume Next ' For debugging

End Sub