sheet excel naar database acces

vaneijk · 6 feb 2018

Geachte helpers van het forum,

Ik ben al enige tijd een programma in excel aan het maken en een database in acces aan het opstellen doordat ons huidige computersystemen moeten worden aangepast. Tot op heden toe lukt dit me aardig en ben ondertussen een heel stuk wijzer geworden met scripten. Helaas loop ik momenteel op het volgende probleem vast:

Wij maken onder andere onze calculaties op sheet in excel, (in de bijlage een fictief voorbeeld bijgevoegd) deze fluctuerende inhoud wil ik naar een accesbestand laten exporteren, in de acces database alle benodige gegevens wegschrijven maar ook de kleur en opmaak zoals van het bijgevoegde voorbeeld. De opmaak na het wegschrijven en/of importeren is voor mij het momenteel het gedeelte waar ik op vast loop maar zeer belangrijk.

Vanuit dit excel document maken wij de offerte op in word, maar wel aan de hand van de opmaak die hierin is verwerkt zoals het vetgedrukte, kleur, open regels. Het wegschrijven van de kleuren, of het vetgedrukte is denk ik een kwestie van 2 extra kolommen in de database maken en de kleur en/of het vetgedrukte in deze kolommen wegschrijven.

De benodigde data die weggeschreven moet worden zou in de kolommen B t/m H staan, kolom O en als laatste E2 . Soms staat er ook info in kolom A, maar dit is vrijwel zelden. Kolommen I t/m N staan normaal de calculaties in ( zie bovenste gedeelte ), deze hoeven niet weggeschreven te worden, wel moeten deze worden geplaatst achter elke regel met waarde, na het importeren van de data uit acces.

Door de vele variabelen hierin zoals de verschillende hoeveelheden data weg te schrijven, de benodigde informatie betreft de opmaak, het "resetten" van het huidige voorbeeld naar de standaardwaardes na het wegschrijven of na het importeren van de data weer de opmaak identiek maken zoals hij is, zou ik hulp van de experts hier op het forum zeer op prijs stellen.

In module1 staat er een voorbeeld van zoals ik het accesbestand laat maken, en hoe ik bedacht had om de basis te exporteren naar acces. Hierin moeten wel alle variabelen nog worden toegevoegd zoals kleur, dik etc.

Alle hulp is welkom en wordt zeer gewaardeerd.

vaneijk · 6 feb 2018

En zo importeer ik momenteel alles vanuit acces naar excel, niet aangepast op het huidige voorbeeld, maar dat zal dan ook wel niet lukken zoals het nu staat.

Code:

Sub Import()
On Error GoTo ErrHandler:
Application.ScreenUpdating = False
var = ""
dbPath = ThisWorkbook.Path & "\naamvanofferte.accdb"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
SQL = "SELECT * FROM Offertesdb WHERE Offnr LIKE '" & var & "%" & "'"
Set rs = New ADODB.Recordset 'assign memory to the recordset
rs.Open SQL, cnn
If rs.EOF And rs.BOF Then
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
''Application.ScreenUpdating = True
MsgBox "Er staat geen data in het bestand!", vbCritical, "Geen data"
Exit Sub
End If
OffSheet2.Range("A3").CopyFromRecordset rs
'Close the recordset and the connection.
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing

On Error GoTo 0
Exit Sub
ErrHandler:

Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure importeren van offerte data"
End Sub

OctaFish · 6 feb 2018

Er ontbreekt een formulier in je voorbeeldje (in ieder geval een procedure), een tabel (Offertesdb) en een incomplete lus (For i = 4 To rw). Zijn die nodig? Zo ja: graag een compleet voorbeeld

.

snb · 6 feb 2018

Zou dit niet voldoende zijn ?

Code:

Sub Import()
 x2="voorbeeld"
 With New ADODB.Recordset
    .Open "SELECT * FROM Offertesdb WHERE Offnr LIKE '" & x2 & "'", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\naamvanofferte.accdb"
    OffSheet2.Range("A3").CopyFromRecordset .DataSource
  End With
End Sub

vaneijk · 7 feb 2018

Beste OctaFish en snb,

Bedankt voor uw reacties, hierbij in onderstaand de juiste procedure zoals ik het bedoeld had met exporteren naar een accesfile (vanaf rw 4 (startbegroting) tot rw 17 (MidBegroting -1) ). Voor de begroting zelf heb ik eigenlijk dezelfde procedure staan, alleen dan is dus de bedoeling vanaf rw 19 (MidBegroting + 1) tot rw 309 (EndBegroting -1) naar de "begrotingtabel" in het accesfile. Ik denk dat ik hiermee al een eind op weg ben met het exporteren van de benodigde data.

Code:

'''''''''''''''''''''Toevoegen aan Bouwkosten database
Sub WriteBouwDatabase()

rw = OffSheet2.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row

On Error GoTo ErrHandlerBouw:
dbPath = ThisWorkbook.Path & "\naam van offerte.accdb"
dbTabl = "Bouwkosten"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
Set rs = New ADODB.Recordset
rs.Open Source:=dbTabl, ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable

For i = StartBegroting.Row To MidBegroting.Row -1
kleur = OffSheet2.Cells(i, 3).Font.ColorIndex
If OffSheet2.Cells(i, 3).Bold = True Then vetgedrukt = "True" Else vetgedrukt = "False"

With rs
.AddNew
.Fields("Id").Value = i
.Fields("Color").Value = kleur
.Fields("Bold").Value = vetgedrukt
.Fields("nr").Value = OffSheet2.Cells(i, 2).Value
.Fields("omschrijving").Value = OffSheet2.Cells(i, 3).Value
.Fields("1h").Value = OffSheet2.Cells(i, 4).Value
.Fields("H").Value = OffSheet2.Cells(i, 5).Value
.Fields("mu1h").Value = OffSheet2.Cells(i, 6).Value
.Fields("mat1h").Value = OffSheet2.Cells(i, 7).Value
.Fields("mo1h").Value = OffSheet2.Cells(i, 8).Value
.Fields("opmerkingen").Value = OffSheet2.Cells(i, 15).Value
.Fields("Uurloon").Value = OffSheet2.Cells(2, 5).Value
.Update
End With
rs.Update
Next i

rs.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Call UserForm_Initialize
On Error GoTo 0
Exit Sub

ErrHandlerBouw:
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure opslaan van data in bouwkosten database"
End Sub

De bedoeling daarna is dat het huidige sheet wordt "gereset", dus moet ik aangeven dat ik vele regels wil wissen uit het sheet en de opmaak gewoon standaard zetten. Dit lijkt mij ook nog wel te realiseren, hoe precies weet ik nog niet.

Het grote probleem wordt dus het importeren voor mij. Normaliter zou ik daarvoor de code in #2 (wel aangepast uiteraard, dit voorbeeld kwam uit een ander script wat ik gebruik) gebruiken, maar die plaatst dan alle gegevens in het sheet wat uiteraard niet mijn bedoeling is. Dan zou ik in kolom B een kleurnummer krijgen, in kolom c vetgedrukt false of true en dan de rest van de data, dan klopt het hele sheet niet meer.
Ik wil dus wel de gegevens weer importeren vanuit acces naar het excel sheet, ik zou alleen willen dat dmv de opgeslagen gegevens het sheet weer wordt opgemaakt zoals het er nu bijstaat.

vaneijk · 7 feb 2018

Deze procedure heb ik staan voor de 2e helft van het sheet te exporteren naar het acces file, eigenlijk hetzelfde als degene in #5

Code:

'''''''''''''''''''''Toevoegen aan Begroting database
Sub WriteBegrotingDatabase()


rw = OffSheet2.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row

On Error GoTo ErrHandlerBegr:
dbPath = ThisWorkbook.Path & "\naam van offerte.accdb"
dbTabl = "Bouwkosten"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
Set rs = New ADODB.Recordset
rs.Open Source:=dbTabl, ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable

For i = MidBegroting.Row To EndBegroting.Row
kleur = OffSheet2.Cells(i, 3).Font.ColorIndex
If OffSheet2.Cells(i, 3).Bold = True Then vetgedrukt = "True" Else vetgedrukt = "False"

With rs
.AddNew
.Fields("Id").Value = i
.Fields("Color").Value = kleur
.Fields("Bold").Value = vetgedrukt
.Fields("nr").Value = OffSheet2.Cells(i, 2).Value
.Fields("omschrijving").Value = OffSheet2.Cells(i, 3).Value
.Fields("1h").Value = OffSheet2.Cells(i, 4).Value
.Fields("H").Value = OffSheet2.Cells(i, 5).Value
.Fields("mu1h").Value = OffSheet2.Cells(i, 6).Value
.Fields("mat1h").Value = OffSheet2.Cells(i, 7).Value
.Fields("mo1h").Value = OffSheet2.Cells(i, 8).Value
.Fields("opmerkingen").Value = OffSheet2.Cells(i, 15).Value
.Fields("Uurloon").Value = OffSheet2.Cells(2, 5).Value
.Update
End With
rs.Update
Next i

rs.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Call UserForm_Initialize
On Error GoTo 0
Exit Sub

ErrHandlerBegr:
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure opslaan van data in begroting database"
End Sub

snb · 7 feb 2018

Ben je bekend met voorwaardelijke opmaak in Excel ?

vaneijk · 7 feb 2018

Nee sorry snb, dat zegt mij helemaal niets.

vaneijk · 7 feb 2018

Ik heb wel al zitten denken om deze sheet geheel te laten exporteren vanuit een userform naar een nieuw extern bestand incl. de gehele opmaak, bv d.m.v.

Code:

Private Sub cmdBACKUP_Click()
cfilename = filename
mapname = dirlocation
    ReDim shArray(x)
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve shArray(x)
                shArray(x) = .List(i)
                x = x + 1
            End If
        Next
    End With
   ThisWorkbook.Sheets(shArray).Copy
   ActiveWorkbook.SaveAs mapname & cfilename, 2
   ActiveWorkbook.Close
MsgBox "Het backup-bestand is opgeslagen als" & vbNewLine & mapname & cfilename
  
Unload Me
End Sub

en dan later dit sheet weer importeren maar dat is eigenlijk iets wat ik niet zou willen. Het liefste verwerk ik alles in de acces database, het lijkt mij makkelijker voor de rest wat hieromheen moet gaan werken, de rest van de gegevens staan ook namelijk in acces.

jkpieterse · 7 feb 2018

Ik zou een veld (=kolom) met "recordtype" aan de tabel toevoegen waarin je kan kiezen uit "Artikel"of "SubKop" (evt nog meer, net wat je nodig hebt). Vervolgens kan je dmv voorwaardelijke opmaak (kijk eens op de Start tab van het lint van Excel!) de opmaak automatisch laten gebeuren op basis van de waarde van dit veld.

jkpieterse · 7 feb 2018

Overigens heb je dan ook een veld nodig met "Subcategorie" zodat je weet bij welke subkop een regel eigenlijk hoort.

vaneijk · 7 feb 2018

dankjewel jkpieterse voor uw reactie en het meedenken. Nu weet ik gelijk wat snb ook bedoeld met de voorwaardelijke opmaak. (ik was misschien even te snel met nee zeggen). Hier heb ik al eens eerder iets mee gemaakt. Ik snap ook wat u bedoeld hiermee. Ik zit gelijk te denken hoe ik dit zou kunnen gaan realiseren in het bestand en in de script. Inderdaad misschien nog wat extra kolommen toevoegen tussen kolom A en B, deze verborgen zetten en aan de hand daarvan de voorwaardelijke opmaak laten realiseren. Ik zou dan met wegschrijven naar de accesdatabase iets moeten maken waardoor excel de verschillen gaat herkennen. Uiteraard ook nog in de database extra kolommen toevoegen voor deze waardes.

jkpieterse · 7 feb 2018

Overigens is jouw methode om een recordset to openen en dan Update te gebruiken erg langzaam. Beter is om een Update SQL statement te laten genereren en die in een keer te laten uitvoeren door het database connectie object. Zie deze link voor hoe de SQL eruit moet zien: https://msdn.microsoft.com/en-us/vb...-delete-records-from-a-table-using-access-sql
Bekijk ook het antwoord van deze link: https://stackoverflow.com/questions/22229765/update-sql-server-table-from-excel-vba

vaneijk · 7 feb 2018

dank u jkpieterse weer voor uw reactie en uw hulp. de sql had ik al geprobeerd anders aan te passen nl:
''rs.CurrentProject.Connection.Execute "INSERT INTO Bouwkosten VALUES (OffSheet2.Cells(i, 3).Font.ColorIndex, OffSheet2.Cells(i, 3).value, OffSheet2.Cells(i, 4).value)" enz. Alleen lukte dit niet en kreeg ik een foutmelding dat ik geen extra punten en komma's mag gebruiken. Ik weet dus ff niet hoe ik dit zou moeten aanpassen, vandaar maar de lange uitgebreide versie ervan in gebruik genomen. Deze kreeg ik wel werkend naar behoeven met mijn 'ontwetendheid'

snb · 7 feb 2018

Mij lijkt Access geen voor de hand liggende plaats om opmaak van een Excel bestand op te slaan.
Je kunt ieder Excelbestand als sjabloon gebruiken met daarin de gewenste voorwaardelijke opmaakregels.

vaneijk · 7 feb 2018

Beste snb,
dank voor uw mening en reactie, dit lijkt mij inderdaad ook uiteindelijk de beste optie hiervoor. Ik denk dat ik #9 moet gaan aanpassen (waar en hoe moet ik nog even uit puzzelen waar in dit voorbeeld, deze heb ik namelijk ook gevonden, misschien kunt u mij daarmee helpen) zodat de gekozen sheet naar een gewenst document wordt gekopieerd. Nu wordt het sheet hiermee volledig gekopieerd zoals de bedoeling is, alleen wordt het in een nieuw excel bestand opgeslagen, dit zou ik graag naar een gekozen document willen laten wegschrijven.

misschien iets met
Extrnpath = "Het gekozen excel document.xlsm"
ThisWorkbook.Sheets(shArray).Copyto Extrnpath

of denk ik hier nu weer te simpel over?

snb · 7 feb 2018

Als je gebruik maakt van een querytable in een Excelbestand is het enige wat je hoeft te doen is het bestand te openen.
De koppeling naar de Accessdatabase wordt dan automatisch ververst/geaktualiseerd.

In VBA volstaat dan:

Code:

getobject("G:\OF\voorbeeld.xlsx").Windows(1).visible=true

vaneijk · 7 feb 2018

dank voor uw advies snb, ik ga hier vanavond weer even mee stoeien om te kijken of ik het geheel werkend krijg zoals ik het momenteel visualiseer.
jkpieterse ook uiteraard bedankt voor uw advies

jkpieterse · 7 feb 2018

De quotes staan niet goed:

Code:

rs.CurrentProject.Connection.Execute "INSERT INTO Bouwkosten VALUES (" & OffSheet2.Cells(i, 3).Font.ColorIndex & ", " & OffSheet2.Cells(i, 3).value & ", " & OffSheet2.Cells(i, 4).value& ")"

vaneijk · 7 feb 2018

hartelijk dank voor het verbeteren van de query jkpieterse, dit scheelt mij een ruime tijd aan puzzelen hieraan. Ik ga vanavond met het geheel weer puzzelen en ik koppel nog wel een reactie terug of alles gelukt is.

snb, jkpieterse, hartelijk dank tot zover. Wordt vervolgt....

sheet excel naar database acces

Gebruiker

Gebruiker

Verenigingslid

Verenigingslid

Gebruiker

Gebruiker

Verenigingslid

Gebruiker

Gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Terugkerende gebruiker

Gebruiker

Wij waarderen jouw privacy