per Makro: Daten aus Base Abfrage / Tabelle in Calc export

[DPunch]

Aloha

(ich find den Desktop die beste Wahl da die Pfadstrukuren bei beiden OS ja unterschiedlich sind und Win 7 ja keine "Eigene Dateien" im alten XP-Stil bietet)

Der Desktop ist im Prinzip nichts anderes als ein Teil der "Eigenen Dateien", sowohl bei XP als auch bei Windows 7.
(Anders wären ja auch keine benutzerdefinierten Desktops für jeden Benutzer möglich).
Unter XP ist der Standardpfad für den Desktop z.B.
C:\Dokumente und Einstellungen\Mustermann\Desktop\
bei Windows 7
C:\Benutzer\Mustermann\Desktop

Du wirst Dir also einen allgemeingültigen Pfad ausdenken müssen.

Davon abgesehen hier mal der Beispielcode (ausgeführt aus einem Formular in einer Datenbank).
Viel Spass damit und frohe Weihnachten.

Code: Alles auswählen

Sub ExportData
	REM Speicherpfad
	sPath = "C:" 
	REM Dateiname
	sTitle = "Datenexport vom " & Date & ".ods"
	REM Name der Abfrage, Tabelle oder SQL-Statement
	'sQueryName = "meineTabelle" 
	'sQueryName = "meineAbfrage"
	sQueryName = "SELECT * FROM ""meineTabelle"""
	
	sURL = ConvertToURL(sPath & "/" & sTitle)
	If FileExists(sURL) Then
		i = MsgBox(">" & sTitle & "<" & Chr(13) & "Datei existiert bereits." & _
						Chr(13) & Chr(13) & "Überschreiben?",52,"Hinweis")
		If i <> 6 Then
			Exit Sub
		End If
	End If
	oCon = thisComponent.Parent.CurrentController.ActiveConnection
	If oCon.Tables.hasByName(sQueryName) Then
		oPrepStatement = oCon.prepareCommand(sQueryName,0)
	ElseIf oCon.Queries.hasByName(sQueryName) Then
		oPrepStatement = oCon.prepareCommand(sQueryName,1)
	Else
		oPrepStatement = oCon.prepareCommand(sQueryName,2)
	End If
	oResult = oPrepStatement.executeQuery
	aColumns = oPrepStatement.Columns.ElementNames
	oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc","_blank", 0, Array())
	oSheet = oDoc.Sheets(0)
	nColumnCount = UBound(aColumns)
	Dim aLine(nColumnCount)
	Dim aData(0)
	aData(0) = aColumns
	nUpperBoundary = 0
	Do While oResult.Next
		nUpperBoundary = UBound(aData)+1
		ReDim Preserve aData(nUpperBoundary)
		ReDim aLine(nColumnCount)
		For i = 0 To nColumnCount
			aLine(i) = oResult.getString(i+1)
		Next i
		aData(nUpperBoundary) = aLine
	Loop
	oRange = oSheet.getCellRangeByPosition(0,0,nColumnCount,nUpperBoundary)
	oRange.setDataArray(aData)
	Dim args(0) as New com.sun.star.beans.PropertyValue
	args(0).Name = "Overwrite"
	args(0).Value = True
	oDoc.StoreAsURL(sURL,args)
	oDoc.close(False)
End Sub

[MikeRo]

Aloha

(ich find den Desktop die beste Wahl da die Pfadstrukuren bei beiden OS ja unterschiedlich sind und Win 7 ja keine "Eigene Dateien" im alten XP-Stil bietet)

Der Desktop ist im Prinzip nichts anderes als ein Teil der "Eigenen Dateien", sowohl bei XP als auch bei Windows 7.
(Anders wären ja auch keine benutzerdefinierten Desktops für jeden Benutzer möglich).
Unter XP ist der Standardpfad für den Desktop z.B.
C:\Dokumente und Einstellungen\Mustermann\Desktop\
bei Windows 7
C:\Benutzer\Mustermann\Desktop

Du wirst Dir also einen allgemeingültigen Pfad ausdenken müssen.

Davon abgesehen hier mal der Beispielcode (ausgeführt aus einem Formular in einer Datenbank).
Viel Spass damit und frohe Weihnachten.

Code: Alles auswählen

Sub ExportData
	REM Speicherpfad
	sPath = "C:" 
	REM Dateiname
	sTitle = "Datenexport vom " & Date & ".ods"
	REM Name der Abfrage, Tabelle oder SQL-Statement
	'sQueryName = "meineTabelle" 
	'sQueryName = "meineAbfrage"
	sQueryName = "SELECT * FROM ""meineTabelle"""
	
	sURL = ConvertToURL(sPath & "/" & sTitle)
	If FileExists(sURL) Then
		i = MsgBox(">" & sTitle & "<" & Chr(13) & "Datei existiert bereits." & _
						Chr(13) & Chr(13) & "Überschreiben?",52,"Hinweis")
		If i <> 6 Then
			Exit Sub
		End If
	End If
	oCon = thisComponent.Parent.CurrentController.ActiveConnection
	If oCon.Tables.hasByName(sQueryName) Then
		oPrepStatement = oCon.prepareCommand(sQueryName,0)
	ElseIf oCon.Queries.hasByName(sQueryName) Then
		oPrepStatement = oCon.prepareCommand(sQueryName,1)
	Else
		oPrepStatement = oCon.prepareCommand(sQueryName,2)
	End If
	oResult = oPrepStatement.executeQuery
	aColumns = oPrepStatement.Columns.ElementNames
	oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc","_blank", 0, Array())
	oSheet = oDoc.Sheets(0)
	nColumnCount = UBound(aColumns)
	Dim aLine(nColumnCount)
	Dim aData(0)
	aData(0) = aColumns
	nUpperBoundary = 0
	Do While oResult.Next
		nUpperBoundary = UBound(aData)+1
		ReDim Preserve aData(nUpperBoundary)
		ReDim aLine(nColumnCount)
		For i = 0 To nColumnCount
			aLine(i) = oResult.getString(i+1)
		Next i
		aData(nUpperBoundary) = aLine
	Loop
	oRange = oSheet.getCellRangeByPosition(0,0,nColumnCount,nUpperBoundary)
	oRange.setDataArray(aData)
	Dim args(0) as New com.sun.star.beans.PropertyValue
	args(0).Name = "Overwrite"
	args(0).Value = True
	oDoc.StoreAsURL(sURL,args)
	oDoc.close(False)
End Sub

Wow, das ist echt ein super code Der hat mir einiges erleichtert! Ich hätte noch eine Frage, kann man auch mehrere Abfragen Exportieren, und für jede Abfrage macht er in dem Dokument eine eigene Tabelle. ?

Und kann man auch anstatt eines neuen CalcDokuments ein bestimmtes nehmen und die daten ab Zeile A12 einfügen? Denn ich habe eine Vorlage in der die ersten 12 Zeilen immer bestimmte Angaben haben und die Daten erst danach kommen, und das auf allen 14 Tabellen/Abfragen

[MikeRo]

Ich probiere schon ein bisschen rum, und habe es geschafft, das er meine Formatierte Vorlage nutzt und die Daten einfügt.

Problem ist, er soll die Daten ja erst ab der 12. Zeile einfügen
Und er soll nicht das Original Dokument nehmen, er soll es als Vorlage öffnen, damit man es neu speichern muss.

Code: Alles auswählen

Sub ExportData
   REM Name der Abfrage, Tabelle oder SQL-Statement
   'sQueryName = "meineTabelle"
   sQueryName = "01 ToilettenPlakate"
   'sQueryName = "SELECT * FROM ""Hauptdaten"""
   oCon = thisComponent.Parent.CurrentController.ActiveConnection
   If oCon.Tables.hasByName(sQueryName) Then
      oPrepStatement = oCon.prepareCommand(sQueryName,0)
      ElseIf oCon.Queries.hasByName(sQueryName) Then
         oPrepStatement = oCon.prepareCommand(sQueryName,1)
      Else
         oPrepStatement = oCon.prepareCommand(sQueryName,2)
   End If
   url=converttourl("C:\Standortlisten.ods")
   oResult = oPrepStatement.executeQuery
   aColumns = oPrepStatement.Columns.ElementNames
   oDoc = StarDesktop.loadComponentFromURL(url,"_blank", 0, Array())
   oSheet = oDoc.Sheets(0)
   nColumnCount = UBound(aColumns)
   Dim aLine(nColumnCount)
   Dim aData(0)
   aData(0) = aColumns
   nUpperBoundary = 0
   Do While oResult.Next
      nUpperBoundary = UBound(aData)+1
      ReDim Preserve aData(nUpperBoundary)
      ReDim aLine(nColumnCount)
      For i = 0 To nColumnCount
         aLine(i) = oResult.getString(i+1)
      Next i
      aData(nUpperBoundary) = aLine
   Loop
   oRange = oSheet.getCellRangeByPosition(0,0,nColumnCount,nUpperBoundary)
   oRange.setDataArray(aData)
   Dim args(0) as New com.sun.star.beans.PropertyValue
   args(0).Name = "Overwrite"
   args(0).Value = True

End Sub 

[DPunch]

Aloha

Ich hätte noch eine Frage, kann man auch mehrere Abfragen Exportieren, und für jede Abfrage macht er in dem Dokument eine eigene Tabelle. ?
(...)
Problem ist, er soll die Daten ja erst ab der 12. Zeile einfügen
Und er soll nicht das Original Dokument nehmen, er soll es als Vorlage öffnen, damit man es neu speichern muss.

Versuchs mal hiermit:

Code: Alles auswählen

Sub ExportData
	REM Namen der Abfragen, Tabellen oder SQL-Statements, mit Kommas getrennt
	aQueries = Array("SELECT * FROM ""Hauptdaten""","meineTabelle")
	url=converttourl("C:\Standortlisten.ods")
	oCon = thisComponent.Parent.CurrentController.ActiveConnection
	Dim args(0) As New com.sun.star.beans.PropertyValue
	args(0).Name = "AsTemplate"
	args(0).Value = True
	oDoc = StarDesktop.loadComponentFromURL(url,"_blank", 0, args)
	Dim aData(0)
	Dim aLine(0)
	For n = 0 To UBound(aQueries)
		sQueryName = aQueries(n)
		If n+1 > oDoc.Sheets.Count Then
			oDoc.Sheets.insertNewByName("Tabelle" & n+1,n)
		End If
		oSheet = oDoc.Sheets(n)
		If oCon.Tables.hasByName(sQueryName) Then
			oPrepStatement = oCon.prepareCommand(sQueryName,0)
		ElseIf oCon.Queries.hasByName(sQueryName) Then
			oPrepStatement = oCon.prepareCommand(sQueryName,1)
		Else
			oPrepStatement = oCon.prepareCommand(sQueryName,2)
		End If
		oResult = oPrepStatement.executeQuery
		aColumns = oPrepStatement.Columns.ElementNames
		nColumnCount = UBound(aColumns)
		ReDim aLine(nColumnCount)
		ReDim aData(0)
		aData(0) = aColumns
		nUpperBoundary = 0
		Do While oResult.Next
			nUpperBoundary = UBound(aData)+1
			ReDim Preserve aData(nUpperBoundary)
			ReDim aLine(nColumnCount)
			For i = 0 To nColumnCount
				aLine(i) = oResult.getString(i+1)
			Next i
			aData(nUpperBoundary) = aLine
		Loop
		oRange = oSheet.getCellRangeByPosition(0,11,nColumnCount,nUpperBoundary+11)
		oRange.setDataArray(aData)
	Next n
End Sub

[MikeRo]

Super danke! Das klappt wunderbar!

Nur gibt es noch ein Problem.

Zahlen werden nicht nackt ausgespuckt, sondern mit einem Apostroph/Hochkomma, und so kann ich keine Teilergebnisse ausführen

[MikeRo]

Gibt es keine Lösung für das Problem mit den Zahlen?
Oder woran kann das liegen, das sie mit einem Hochkomma ausgespuckt werden?

[MikeRo]

Ja, das stimmt, in der Datenbank sind die Werte als Integer, allerdings habe ich auch eine Externe Postgresql Datenbank, auf die ich mit Base zugreife und die Abfragen mache ich auch über Base.

Der Export ist sehr wichtig, da wir so einiges im Büro automatisieren wollen, aber ich bekomme es nicht hin, das dort einfach nur die Zahlen stehen, damit ich die Teilwergebnise starten kann.

[DPunch]

Aloha

Ersetz mal

Code: Alles auswählen

oRange.setDataArray(aData)

durch

Code: Alles auswählen

oRange.setFormulaArray(aData)

und überprüf dann, ob das besser funktioniert.

[MikeRo]

Aloha

Ersetz mal

Code: Alles auswählen

oRange.setDataArray(aData)

durch

Code: Alles auswählen

oRange.setFormulaArray(aData)

und überprüf dann, ob das besser funktioniert.

Super Danke! Jetzt geht alles wunderbar.

Eine Frage habe ich noch, was ist eigentlich, wenn ich das Formular extern speichere, damit die Kollegen nur noch über das Writer Dokument zugreifen?
Ich habe es probiert, aber einen Fehler bekommen.

[MikeRo]

Ich habe es geschafft, das Formular extern zu speichern und die Datenbank wird dann geöffnet, man muss nur das Formular oben anpassen und die oCon Zeile mit der hier ersetzen

Code: Alles auswählen

   
DatabaseContext = createUnoService("com.sun.star.sdb.DatabaseContext")
DataSource = DatabaseContext.getByName("DB 3.0")
oCon = DataSource.GetConnection("","")

Wichtig, die DB muss eingebunden sein!

[MikeRo]

Hallo, ich habe etwas weiter gearbeitet mit dem Makro nur schaffe ich es gerade nicht, das mir die Datensätze ohne die Spaltenüberschriften ausgegeben werden

Code: Alles auswählen

Call DB
Call SQL
	
  	ReDim aData(0)
        ReDim aLine(0)

      oPrepStatement = oCon.prepareCommand(Rabatte,2)
      oResult = oPrepStatement.executeQuery
      aColumns = oPrepStatement.Columns.ElementNames
      nColumnCount = UBound(aColumns)
      ReDim aLine(nColumnCount)
      ReDim aData(0)
      aData(0) = aColumns
      nUpperBoundary = 0
      Do While oResult.Next
         nUpperBoundary = UBound(aData)+1
         ReDim Preserve aData(nUpperBoundary)
         ReDim aLine(nColumnCount)
         For x = 0 To nColumnCount
            aLine(x) = oResult.getString(1)
         Next x
         aData(nUpperBoundary) = aLine
      Loop
      oRange = oSheet.getCellRangeByPosition(LetzteSpalte+i,10,Letztespalte+i+nColumnCount,nUpperBoundary+10)
      oRange.setFormulaArray(aData)

Es ist eine Abfrage mit nur einer Spalte und die Ergebnisse müssen untereinander ausgegeben werden.
Vielleicht kann ja jemand hinter jeder Zeile kurz sagen, was gerade passiert. damit ich das Programm mal zu 100%verstehe =)
Danke


**EDIT

Habe es selber hinbekommen

Code: Alles auswählen

Call SQL

      oPrepStatement = oCon.prepareCommand(Rabatte,2)
      oResult = oPrepStatement.executeQuery
      aColumns = oPrepStatement.Columns.ElementNames
      nColumnCount = UBound(aColumns)
      ReDim aLine(nColumnCount)
      ReDim aData(0)
      aData(0) = aColumns
      nUpperBoundary = 0
      Do While oResult.Next()
      nUpperBoundary = UBound(aData)+1
         
         ReDim Preserve aData(nUpperBoundary)
         
         			s = oResult.getString(1)
        	   	   	RabattUeberschrift = oDoc.sheets.getByName("Angebot").getCellByPosition(LetzteSpalte+i,10+nUpperBoundary)
        	   	   	RabattUeberschrift.String = s
				   	RabattUeberschrift.isTextWrapped = TRUE
		
		
		Loop

[BerndV]

Schön, dass du noch selbst eine Lösung gefunden hast. Bin gerade erst auf deinen Beitrag gestoßen, hätte dir sonst gerne schon eher weitergeholfen.


Moderation ,4: Signatur mit SPAM Link ausgeschaltet

[Ryoho]

Hallo, Dieses Thema ist ja vor Jahren Bereits aufgekommen,
Leider brauch ich es nun. Ich habe das Problem das Meine Abfrage eine Variable enthält und erst mit dem Ausführen vom Formular bekommt diese Variable Ihren wert.
Nun ist es so das das gewünschte Ergebnis Exportiert werden soll. Das Makro ist Spitze. Problem ist nur das ich es nicht hin bekomme die Variable mit einzubinden. Ich danke im Voraus.

[tobiman26]

Echt Super Code muss man sagen
bei mir bringt er allerdings einen Basic-Laufzeitfehler beim Speichern

Code: Alles auswählen

com.sun.star.task.ErrorCodeIOException

Message: .
kann mir da jemand sagen woran das liegt?