völlig Ratlos stehe ich hier an der Mauer eines Problems.
Das neue Excel 2010 kann mein Makro nicht mehr bewältigen.
Die Microsoft DAO habe ich in den Verweisen selektiert.
Sub executeSQL1()
Dim SMSG As String
Dim DBWS As Workspace ' Hier kommt Fehlermeldung aber das DAO Objekt habe ich in den _
Verweisen selektiert.
Dim CONDB As Connection
Dim RSTABLE As Recordset
Dim SCONNECT As String
Dim SSQLSELECT As String
Dim ARTIKELNUMMER As String
Dim Resultat
If ActiveSheet.Range("T3").Value "Jahr" Then
Resultat = MsgBox("Soll die aktuelle Markierung als Artikelnummer übernommen werden?", _
_
_
_
vbYesNo, "Frage Artikelnummer aus Markierung")
If Resultat = vbNo Then
ARTIKELNUMMER = InputBox("Bitte Artikelnummer eingeben:")
Else
ARTIKELNUMMER = Selection
End If
Else
ARTIKELNUMMER = Cells(13, 21).Value
End If
Set DBWS = CreateWorkspace("TempWorkspace", "Excel", "", dbUseODBC)
SCONNECT = "ODBC;DSN=E812PROD;UID=xxxxxxxx;PWD=xxxxxxx;DBQ=E812PROD;DBA=W;" & _
"APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM= _
IfAllSuccessful;" & _
"NUM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;"
Set CONDB = DBWS.OpenConnection("get", dbDriverNoPrompt, dbReadOnly, SCONNECT)
SSQLSELECT = "Select F4101.IMITM, TO_CHAR(F4101.IMDSC1) AS DSC1, TO_CHAR(F4101.IMSTKT) AS _
_
_
STKT," _
& "TO_CHAR(F4101.IMMPST) AS MPST, TO_CHAR(F4101.IMAPSC) AS APSC, TO_CHAR(F4101. _
_
_
IMPRP0) AS PRP0," _
& "TO_CHAR(F4101.IMSRP6) AS SRP6 " _
& "FROM PRODDTA.F4101 WHERE F4101.IMITM =" & ARTIKELNUMMER
Set RSTABLE = CONDB.OpenRecordset( _
SSQLSELECT, dbOpenDynamic)
With RSTABLE
If .RecordCount > 0 Then
SMSG = .Fields(0).Value & " - " & .Fields(1).Value & vbCrLf & vbLf
SMSG = SMSG & "STKT:" & vbTab & .Fields(2).Value & vbCrLf
SMSG = SMSG & "MPST:" & vbTab & .Fields(3).Value & vbCrLf
SMSG = SMSG & "APSC:" & vbTab & .Fields(4).Value & vbCrLf
SMSG = SMSG & "PRP0:" & vbTab & .Fields(5).Value & vbCrLf
SMSG = SMSG & "SRP6:" & vbTab & .Fields(6).Value
MsgBox SMSG, vbOKOnly + vbInformation, "Artikelnummer: " & .Fields(0)
End If
.Close
End With
CONDB.Close
End
End Sub
Danke für Eure Hilfe oder Tips