Office: (Office 2003) Und Oder Gleich

Arne Dieckmann · 25. Februar 2011

OT (die Kritik ist nicht an Benny gerichtet): Das

Zur weiteren Analyse empfehle ich, Dir mal den Inhalt von Mysql ausgeben zu lassen, bevor Du das RecordSet öffnest.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

müsste man eigentlich nicht mehr vorschlagen, weil ich ihm das bestimmt auch schon gefühlte 10mal geschrieben habe (mit Link zum Thema "Debug.Print" auf meiner Seite).

CptChaos · 25. Februar 2011

OT: Na, den Link nehm ich doch gleich mal in meine Sig auf *wink.gif*

Scorefun · 25. Februar 2011

gelöscht

Thomas Möller · 25. Februar 2011

Hallo Ralf,

Code:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

oSh.Name = "Woche " & .Fields(0) '//Objektvariabel oder With-Blockvariabel
' nicht festgelegt
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

das habe ich auch erst gedacht - bis mir diese Stelle im Quellcode aufgefallen ist. *Smilie

CU

Scorefun · 25. Februar 2011

\@Thomas: Deshalb habe ich meinen beitrag auch wieder gelöscht *biggrin.gif*

Thomas Möller · 25. Februar 2011

Hallo Ralf,

Deshalb habe ich meinen beitrag auch wieder gelöscht
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ich lösch meinen Beitrag jetzt mal nicht. *wink.gif*

Vielleicht fällt es ja dem geneigten Leser so leichter, die entscheidende Stelle im Code ausfindig zu machen.

CU

Erich290607 · 25. Februar 2011

Hallo Thomas,

irgendwie geht es nicht voran bei mir!

mein Konstrukt komplett, ich hoffe kriege nicht schon wieder böse Worte
aber wie gesagt ich möchte s. Bild einen Suchbegriff finden und das ganze nach Excel exportieren je Woche ein Tabellenblatt anlegen.

Code:

Dim db As DAO.Database
Dim Suchbegriffe() As String
Dim strOperator As String
Dim strSQL As String
Dim I As Integer
Dim strKriterium As String
Dim strSuchbegriffe() As String
Dim rsID As DAO.Recordset
Dim rsDat As DAO.Recordset
Dim oXL As Object
Dim oWb As Object
Dim oSh As Object
Dim t As Long
Dim Start As Long
Dim lZeile2 As Integer
Dim strJNummer As String
Dim Mysql As String
Dim DATNA As String
Dim FELDNA As String

strJNummer = InputBox("Bitte geben Sie das Jahr an, welches ausgewertet werden soll", "Schichtbuchdaten")

On Error Resume Next
Me!DATEINAME2 = Application.CurrentProject.path & "\Schichtbuchdaten.xls"
'//DATNA = "Lagerort Halle-6"

Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Add
oXL.Visible = True
Set db = CurrentDb
Set rsID = db.OpenRecordset("SELECT DISTINCT Year([StörDatum]) & ' ' & Format(DKW([StörDatum]),'00') AS KW," & _
" Year([StörDatum]) AS J" & _
" FROM tblStoerungen AS ST" & _
" WHERE Year([StörDatum]=" & strJNummer, dbOpenForwardOnly)

With rsID
Do While Not .EOF 'jetzt hängt es hier

On Error Resume Next
Me!DATEINAME2 = "\\SB\Bereich05\SB_Ergebniss.xls"
'//DATNA = "SB_GC"
Set oExcel = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set oExcel = CreateObject("Excel.Application")
End If

Set oSh = oWb.Worksheets.Add
oSh.Name = "Woche " & .Fields(0) '//Objektvariabel oder With-Blockvariabel
' nicht festgelegt

On Error GoTo 0
If Len(Nz(Me.txtSuchbegriffe, "")) > 0 Then
Set db = CurrentDb
strSuchbegriffe = Split(Me.txtSuchbegriffe, " ")

If Me.ogrVerknuepfung = 2 Then
strOperator = "="
End If

If Me.ogrVerknuepfung = 1 Then
strOperator = "AND"
Else
strOperator = "OR"
End If

End If

Mysql = "SELECT tblArbeitsfolge.Arbeitsfolge, tblStoerungen.Stoergrund, tblStoerungen.StörDatum," & _
" tblStoerungen.StoerZeitM, tblBereiche.Bereich, tblSchichtarten.Schichtart," & _
" tblMitarbeiterNamen.Name, tblStoerungen.DS_ID, tblStoerungen.StörungID_P," & _
" tblStoerungen.NrJahr , tblMaschine.Bezeichnung" & _
" FROM tblMaschine INNER JOIN (tblMitarbeiterNamen INNER JOIN" & _
" (tblBereiche INNER JOIN (tblArbeitsfolge INNER JOIN (tblSchichtarten INNER JOIN tblStoerungen" & _
" ON tblSchichtarten.SchichtArtID_P = tblStoerungen.SchichtartID_F)" & _
" ON tblArbeitsfolge.ArbeitsfolgeID = tblStoerungen.ArbeitsfolgeID_F)" & _
" ON tblBereiche.BereichID_P = tblStoerungen.BereichID_F)" & _
" ON tblMitarbeiterNamen.MitarbeiterID_P = tblStoerungen.MitarbeiterID_F)" & _
" ON tblMaschine.MaschineID_P = tblStoerungen.MaschinenID_F WHERE "

For I = 0 To UBound(strSuchbegriffe)
strKriterium = strKriterium & " " & strOperator & " Stoergrund LIKE '*" & strSuchbegriffe(I) & "*'"
Next I

strKriterium = Mid(strKriterium, 5)
Mysql = Mysql & strKriterium

Loop

Set db = CurrentDb
Set rsDat = db.OpenRecordset(Mysql, dbOpenDynaset)

With rsDat

Do While Not .EOF

oSh.Range("A1").Value = "BMG"
oSh.Range("A2").Value = "Halle 6 / 4"
oSh.Range("B1").Value = "Störungsliste"
oSh.Range("B2").Value = "Erstellt: " & "" & Now

With oSh.Range("A4:G4").Interior
.ColorIndex = 43 '43, 40
.Pattern = xlSolid
End With

.MoveNext

Loop

With oXL

FELDNA = Dir(Me!DATEINAME2)
If Not IsNull(FELDNA) And FELDNA "" Then
Kill Me!DATEINAME2
End If
.ErrorCheckingOptions.OmittedCells = False
oWb.SaveAs Me!DATEINAME2

.ErrorCheckingOptions.OmittedCells = True
.Quit

MsgBox "Störungsmappe unter: " & vbCrLf & _
Me!DATEINAME2 & vbCrLf & _
"gespeichert", vbInformation, "Stördauerverlauf"

End With
End With
End With

rsDat.Close

Set oExcel = Nothing
Set oXL = Nothing
EndeEX2:
Exit Sub
FehlerEx2:
If Err 91 Then
FEHKZ = 9
MsgBox Err.Number & " " & Err.Description
End If
MsgBox Err.Number & " " & Err.Description
Resume EndeEX2
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Maxel · 25. Februar 2011

Hallo Erich,

wenn Du nach Jahr filterst, sollte
Code:

Dim strJNummer As String
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

geändert werden zu
Code:

Dim strJNummer As Long
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wobei lngJNummer ein besserer Name wäre.

Erich290607 · 25. Februar 2011

Hallo Maxel,

nun bekomme ich das Tabellenblatt wie ich möchte die Mappe wird mit den Woche aus dem Jahr xxxx erstellt. Nun sollen die "Such Ergebnisse zur jeder Woche geschrieben werden"

Danke für den Hinweis.
1. Schritt Mappe anlegen

Code:

Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Add
oXL.Visible = True
On Error Resume Next
Me!DATEINAME2 = "\\SB\Bereich05\SB_Ergebniss.xls"
'//DATNA = "SB_GC"
Set oExcel = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set oExcel = CreateObject("Excel.Application")
End If

Set db = CurrentDb
Set rsID = db.OpenRecordset("SELECT abf_YW.KW, abf_YW.J " & _
" FROM abf_YW " & _
" WHERE abf_YW.J =" & lngJNummer, dbOpenForwardOnly)

Do While Not rsID.EOF

Set oSh = oWb.Worksheets.Add
oSh.Name = rsID.Fields(0) 'Tabellenblatt Jahr + Woche

Debug.Print rsID!KW

rsID.MoveNext

Loop
rsID.Close
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Micha_DU · 25. Februar 2011

Ich bin leider genauso unverbesserlich wie Du Erich, ich poste doch wieder in einem Thread von Dir
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

du bist, wie viele andere hier, einfach zu gut für dieses Forum *wink.gif*

@Erich:
alle lernen und wachsen mit ihren Aufgaben... warum klappt das bei dir nicht?

Erich290607 · 25. Februar 2011

weiß ich auch nicht, aber so kommen wir auch nicht weiter oder?

Micha_DU · 25. Februar 2011

aber so kommen wir auch nicht weiter oder?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wir? In erster Linie musst du weiterkommen... und du zeigst wie immer erhebliche Lernresistenz, angefangen bei deiner Code-Darstellung hier im Forum.
Ich hab jetzt ehrlich gesagt keine Lust meine Birne qualmen zu lassen um deine Probleme zu lösen.

Scorefun · 25. Februar 2011

Mich wundert dieses Konstrukt hier sowieso...

Code:

Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Add
oXL.Visible = True

...

Set oExcel = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set oExcel = CreateObject("Excel.Application")
End If

...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wofür brauchst Du Excel zweimal ?

sw-blitz007 · 25. Februar 2011

Mit GetObject() bekommst Du hier eine Referenz auf ein bereits laufendes Excel.
Mit CreateObject() wird ein neues Objekt erzeugt, also hier bspw. Excel gestartet.

Erich290607 · 25. Februar 2011

Sorry, das ich den Code noch mal reinstelle
aber ich bekomme immer wieder andere Fehler, jetzt es wurden zu wenig Parameter ....

Bitte, Bitte wer hilft mir dabei auch Schritt für Schritt hauptsache das läuft
so wie es gewünscht wird.

Code:

Dim db As DAO.Database
Dim Suchbegriffe() As String
Dim strOperator As String
Dim strSQL As String
Dim I As Integer
Dim strKriterium As String
Dim strSuchbegriffe() As String
Dim rsID As DAO.Recordset
Dim rsDat As DAO.Recordset
Dim oXL As Object
Dim oWb As Object
Dim oSh As Object
Dim t As Long
Dim Start As Long
Dim lZeile2 As Integer
Dim lngJNummer As Long
Dim Mysql As String
Dim DATNA As String
Dim FELDNA As String
Dim tmp, TTD, Addr, rs As DAO.Recordset, _
TransP As Boolean, j As Long, B As Long, St As Long

lngJNummer = InputBox("Bitte geben Sie das Jahr an, welches ausgewertet werden soll", "Schichtbuchdaten")

On Error Resume Next
Me!DATEINAME2 = Application.CurrentProject.path & "\Schichtbuchdaten.xls"
'//DATNA

Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Add
oXL.Visible = True
On Error Resume Next
Me!DATEINAME2 = "\\SB\Bereich05\SB_Ergebniss.xls"
'//DATNA =
Set oExcel = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set oExcel = CreateObject("Excel.Application")
End If

Set db = CurrentDb
Set rsID = db.OpenRecordset("SELECT abf_YW.KW, abf_YW.J " & _
" FROM abf_YW " & _
" WHERE abf_YW.J =" & lngJNummer, dbOpenForwardOnly)

With oExcel
Do While Not rsID.EOF
On Error Resume Next

'//On Error GoTo FehlerEx2

.ActiveSheet.Name = rsID.Fields(0) 'Tabellenblatt Jahr + Woche

Set oSh = oWb.Worksheets.Add
oSh.Name = rsID.Fields(0) 'Tabellenblatt Jahr + Woche

oSh.Cells(4, I + 1) = rsDat.Fields(I).Name

On Error GoTo 0
If Len(Nz(Me.txtSuchbegriffe, "")) > 0 Then
Set db = CurrentDb
strSuchbegriffe = Split(Me.txtSuchbegriffe, " ")
If Me.ogrVerknuepfung = 2 Then
strOperator = "="
End If
If Me.ogrVerknuepfung = 1 Then
strOperator = "AND"
Else
strOperator = "OR"
End If
End If

Mysql = "SELECT abf_Schichtbuchdaten.StörungID_P, " & _
" abf_Schichtbuchdaten.Stoergrund, " & _
" abf_Schichtbuchdaten.StörDatum, " & _
" abf_Schichtbuchdaten.Arbeitsfolge," & _
" abf_Schichtbuchdaten.StoerZeitM," & _
" abf_Schichtbuchdaten.Schichtart " & _
" FROM abf_Schichtbuchdaten WHERE "

For i = 0 To UBound(strSuchbegriffe)
strKriterium = strKriterium & " " & strOperator & " Stoergrund LIKE '*" & strSuchbegriffe(i) & "*'"
Next i
strKriterium = Mid(strKriterium, 5)
Mysql = Mysql & strKriterium

Set db = CurrentDb
Set BD = db.OpenRecordset(Mysql, dbOpenDynaset)

With oExcel
Do While Not rsID.EOF
On Error Resume Next

'//On Error GoTo FehlerEx2

.ActiveSheet.Name = rsID.Fields(0) 'Tabellenblatt Jahr + Woche

Set oSh = oWb.Worksheets.Add
oSh.Name = rsID.Fields(0) 'Tabellenblatt Jahr + Woche
For i = 0 To BD.Fields.count - 1
oSh.Cells(4, i + 1) = BD.Fields(i).Name

oSh.Range("A1").Value = "BMG"
oSh.Range("A2").Value = "Halle 6 / 4"
oSh.Range("C1").Value = "Störungsliste"
oSh.Range("C2").Value = "Erstellt"
oSh.Range("D2").Value = Now

rsID.MoveNext

j = 1
B = 1
' Lesen ersten Datensatz des Recordsets

If i = 0 Then
j = j + 1
i = 9
j = 4
.Cells(j, 1) = "Nummer"
.Cells(j, 2) = "Eintrag"
.Cells(j, 3) = "Tag"
.Cells(j, 4) = "Schicht"
.Cells(j, 5) = "Station"
.Cells(j, 6) = "Minuten"
.Cells(j, 7) = "Jahr"

j = j + 1

End If
.Cells(j, 1) = BD!StörungID_P
.Cells(j, 2) = BD!Stoergrund
.Cells(j, 3) = BD!StörDatum
.Cells(j, 4) = BD!Schichtart
.Cells(j, 5) = BD!Arbeitsfolge
.Cells(j, 6) = BD!StoerZeitM
.Cells(j, 7) = BD!NrJahr

j = j + 1

Next

BD.MoveNext

Loop

End With

rsID.Close
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.