Von DAO zu ACEDAO

Betreff	Von DAO3.6 zu ACEDAO
Von	"Marco"
Datum	05.11.2009 15:17:41

Hallo Profis

Ich habe ein Problem und weiss da nicht mehr weiter.

Wir hatten ein VB Makro in Excel 2007 laufen, welches auf eine Access 2003
mdb Datenbank zugegriffen hat.
Jetzt wurde diese Datenbank ins ACCDB Format konvertiert und seit dem funzt
auch das Makro nicht mehr :-(

Ich hab mich bissi schlau gemacht und herausgefunden, dass es jetzt nicht
mehr die DAO3.6 als Library benötigt, sondern die ACEDAO, da nur die auf das
ACCDB Access Fileformat zugreifen kann.

Hab die Library zusätzlich zur DAO3.6 eingebunden, aber erhalten leider
jetzt dennoch einen Fehler und zwar bei diesem Befehl:

If db Is Nothing Then Set db = OpenDatabase(sDBPath)

Was muss ich denn noch ändern, damit das Makro wieder läuft?

Kann mir da jemand helfen?

Vielen Dank

Gruss Marco

P.S. Hier das ganze Makro
-------------------------------------------------------------------

Const sDBPath = "X:\Apps\MATCALC\MatCalc_d.accdb"
Global db As Database
Sub StartRueckstellungen()
Application.DisplayStatusBar = True
Application.StatusBar = "Programm läuft..."
fUpdate
fCreateSheet
Application.StatusBar = ""
End Sub
Function fUpdate()
Dim sh As Worksheet
Dim dARNR As Variant, dRow As Double, vData As Variant
Set sh = ThisWorkbook.Sheets("Daten")
dLastRow = sh.[a36000].End(xlUp).Row
For dRow = 2 To dLastRow
fDelContent sh, dRow
dARNR = sh.Cells(dRow, 1)
dARNR = Replace(Replace(dARNR, " ", ""), "-", "")
If Not dARNR = "" And IsNumeric(dARNR) Then
vData = fGetPrice(dARNR)
If Not IsEmpty(vData) Then
sh.Cells(dRow, 3) = vData(0)
sh.Cells(dRow, 4) = vData(1)
sh.Cells(dRow, 5) = vData(2)
End If
End If
Next
sh.Columns.AutoFit
sh.Range("A2:E" & dLastRow).Sort Key1:=Range("D2"), Order1:=xlAscending
End Function
Function fGetPrice(ByVal dARNR As Double) As Variant
Dim rsArt As Recordset, sSQL As String, vData(2) As Variant
If db Is Nothing Then Set db = OpenDatabase(sDBPath)
sSQL = "SELECT ArtPreisHKFix, LagerortNr_FK, LieferantenNr_FK FROM
t_Artikel WHERE ArtFirmaArtikelNr=" & dARNR
Set rsArt = db.OpenRecordset(sSQL, dbOpenForwardOnly)
If Not rsArt.RecordCount = 0 Then
If Not IsNull(rsArt!LieferantenNr_FK) And Not rsArt!LieferantenNr_FK
= "" Then
sSQL = "SELECT LiefName FROM t_Lieferanten WHERE
LiefernantenNr=" & rsArt!LieferantenNr_FK
Set rsLief = db.OpenRecordset(sSQL, dbOpenForwardOnly)
If Not rsLief.RecordCount = 0 Then vData(0) = rsLief!LiefName
End If
If Not IsNull(rsArt!LagerortNr_FK) And Not rsArt!LagerortNr_FK = ""
Then
sSQL = "SELECT LOBezeichnung FROM t_Lagerorte WHERE LagerortNr="
& rsArt!LagerortNr_FK
Set rsLO = db.OpenRecordset(sSQL, dbOpenForwardOnly)
If Not rsLO.RecordCount = 0 Then vData(1) = rsLO!LOBezeichnung
End If
vData(2) = rsArt!ArtPreisHKFix
fGetPrice = vData
End If
End Function
Function fDelContent(sh As Worksheet, dRow As Double)
With sh.Range("C" & dRow & ":E" & dRow)
.ClearContents: .ClearComments: .ClearFormats: .ClearNotes:
.ClearOutline
End With
End Function
Function fCreateSheet()
Dim wbNew As Workbook
Dim sh As Worksheet, shNew As Worksheet
Set sh = ThisWorkbook.Sheets("Daten")
Set wbNew = Application.Workbooks.Add
Set shNew = wbNew.Sheets(1)
shNew.Columns.Font.Size = 10: shNew.Columns.Font.Name =
"Arial"
shNew.Columns(1).ColumnWidth = 33.14: shNew.Columns(2).ColumnWidth
= 18
shNew.Columns(5).NumberFormat = "0.00":
shNew.Columns(6).NumberFormat = "0.00"
shNew.Cells(1, 1) = "Rückstellungen per"
shNew.Range(shNew.Cells(1, 1), shNew.Cells(1, 6)).Font.Size = 12
shNew.Range(shNew.Cells(1, 1), shNew.Cells(1, 6)).Font.Bold = True
shNew.Range(shNew.Cells(1, 1), shNew.Cells(1,
6)).Borders(xlEdgeBottom).LineStyle = 1
shNew.Cells(3, 1) = "Lager- und Kübelteile": shNew.Cells(3, 1).Font.Bold
= True
shNew.Cells(5, 1) = "Lieferant": shNew.Cells(5, 1).Font.Underline = True
shNew.Cells(5, 2) = "Artikelnr.": shNew.Cells(5, 2).Font.Underline =
True
shNew.Cells(5, 3) = "Lagerort": shNew.Cells(5, 3).Font.Underline = True
shNew.Cells(5, 4) = "Menge": shNew.Cells(5, 4).Font.Underline = True
shNew.Cells(5, 5) = "Preis fixiert": shNew.Cells(5, 5).Font.Underline =
True
shNew.Cells(5, 6) = "Total": shNew.Cells(5, 6).Font.Underline = True
shNew.Cells(6, 5) = "CHF": shNew.Cells(6, 6) = "CHF"
shNew.Cells(7, 1) = "Lager": shNew.Cells(7, 1).Font.Color = 16711680:
shNew.Cells(7, 1).Font.Underline = True
dRowNew = 9
dRowNewStart = dRowNew
dLastRow = sh.[a36000].End(xlUp).Row
For dRow = 2 To dLastRow
sLo = sh.Cells(dRow, 4)
If InStr(1, sLo, "K") = 0 Then
shNew.Cells(dRowNew, 1) = sh.Cells(dRow, 3)
shNew.Cells(dRowNew, 2) = sh.Cells(dRow, 1)
shNew.Cells(dRowNew, 3) = sh.Cells(dRow, 4)
shNew.Cells(dRowNew, 4) = sh.Cells(dRow, 2)
shNew.Cells(dRowNew, 5) = sh.Cells(dRow, 5)
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=RC[-1]*RC[-2]"
dRowNew = dRowNew + 1
End If
Next
dRowNew = dRowNew + 1
shNew.Cells(dRowNew, 1) = "Lager"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUM(R[-2]C:R[-" & dRowNew -
dRowNewStart & "]C)"
dRowNew = dRowNew + 2
shNew.Cells(dRowNew, 1) = "Kundenaufträge"
dRowNew = dRowNew + 2
shNew.Cells(dRowNew, 1) = "Reserve"
dRowNew = dRowNew + 2
shNew.Cells(dRowNew, 1) = "Total Lager 1065":
shNew.Rows(dRowNew).Font.Bold = True
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUM(R[-2]C:R[-6]C)"
dRowNew = dRowNew + 3
shNew.Cells(dRowNew, 1) = "Kübelteile": shNew.Cells(dRowNew,
1).Font.Color = 16711680
shNew.Cells(dRowNew, 1).Font.Underline = True
dRowNew = dRowNew + 2
dRowNewStart = dRowNew
For dRow = 2 To dLastRow
sLo = sh.Cells(dRow, 4)
If InStr(1, sLo, "K") > 0 Then
shNew.Cells(dRowNew, 1) = sh.Cells(dRow, 3)
shNew.Cells(dRowNew, 2) = sh.Cells(dRow, 1)
shNew.Cells(dRowNew, 3) = sh.Cells(dRow, 4)
shNew.Cells(dRowNew, 4) = sh.Cells(dRow, 2)
shNew.Cells(dRowNew, 5) = sh.Cells(dRow, 5)
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=RC[-1]*RC[-2]"
dRowNew = dRowNew + 1
End If
Next
dRowNew = dRowNew + 1
shNew.Cells(dRowNew, 1) = "Total Kübel 3100":
shNew.Rows(dRowNew).Font.Bold = True
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=R[-2]C+R[-" & dRowNew -
dRowNewStart & "]C"
dRowNew = dRowNew + 2
shNew.Cells(dRowNew, 1) = "Kostenarte-Zusammenfassung"
shNew.Cells(dRowNew, 1).Font.Underline = True
dRowNew = dRowNew + 1: shNew.Cells(dRowNew, 1) = "3100 / 3101":
shNew.Cells(dRowNew, 2) = "KL1"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUMIF(C[-3],RC[-4],C)"
dRowNew = dRowNew + 1: shNew.Cells(dRowNew, 1) = "3100 / 3102":
shNew.Cells(dRowNew, 2) = "KL2"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUMIF(C[-3],RC[-4],C)"
dRowNew = dRowNew + 1: shNew.Cells(dRowNew, 1) = "3100 / 3104":
shNew.Cells(dRowNew, 2) = "KL4"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUMIF(C[-3],RC[-4],C)"
dRowNew = dRowNew + 1: shNew.Cells(dRowNew, 1) = "3100 / 3105":
shNew.Cells(dRowNew, 2) = "KL5"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUMIF(C[-3],RC[-4],C)"
dRowNew = dRowNew + 1: shNew.Cells(dRowNew, 1) = "3100 / 3106":
shNew.Cells(dRowNew, 2) = "KL6"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUMIF(C[-3],RC[-4],C)"
dRowNew = dRowNew + 1: shNew.Cells(dRowNew, 1) = "3100 / 3107":
shNew.Cells(dRowNew, 2) = "KL7"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUMIF(C[-3],RC[-4],C)"
dRowNew = dRowNew + 1: shNew.Cells(dRowNew, 1) = "3100 / 3109":
shNew.Cells(dRowNew, 2) = "KET"
shNew.Cells(dRowNew, 6).FormulaR1C1 = "=SUMIF(C[-3],RC[-4],C)"

End Function

Betreff	Re: Von DAO3.6 zu ACEDAO
Von	"Thorsten Albers"
Datum	05.11.2009 17:38:15

Marco schrieb im Beitrag
<#v5LKLiXKHA.4148@TK2MSFTNGP04.phx.gbl>...
> Wir hatten ein VB Makro in Excel 2007 laufen, welches auf eine Access
2003
> mdb Datenbank zugegriffen hat.
> Jetzt wurde diese Datenbank ins ACCDB Format konvertiert und seit dem
funzt
> auch das Makro nicht mehr :-(

Fragen zur Datenbank-Programmierung mit MS Visual Basic <= 6.0
gehören in die Newsgroup microsoft.public.de.vb.datenbank!

--
----------------------------------------------------------------------
THORSTEN ALBERS Universität Freiburg
albers@
uni-freiburg.de
----------------------------------------------------------------------