Van Access naar Excel

WiBoData

Steunend lid
Vip Lid
Aan alle programmeurs in VBA ACCESS,

Wie kan mij een EENVOUDIG programmamodulle in VBA aan de hand doen dat echt WERKT?
de meeste programmaatjes die je op het internet vindt zijn waanzinnig ingewikkeld ofwel werken ze niet. Ik zoek iets eenvoudig dat gegevens uit Access opgeslagen in een tabel (tblAdressen, qryAdres) kan overbrengen naar Excel (Adresgegevens.xlsx) zonder dat de xlsx file alleen lezen of beveiligd is, of zeer ingewikkelde bochten en kronkels maakt die voor niets nodig zijn.

Met de meeste dank,
WiBoData
 

Skippy

Beheerder
Forumleiding
Admin
En als u het nou eens vanuit access exporteert naar een excel bestand.
 

knoet

Steunend lid
Vip Lid
Makkelijker dan dit kan ik het niet maken.
Code:
Sub tuts()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String
strFilePath = "C:\AccessFolder\tutsDB.accdb"   'Vervang AccesFolder en tutsDB.accdb met je DB pad and DB naam
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strFilePath & ";"
    sQRY = "SELECT * FROM test" 'Vervang test met uw Access DB Tabel naam of Query naam
    rs.CursorLocation = adUseClient
    rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheets("blad1").Range("A1").CopyFromRecordset rs 'Vervang blad1 met de echte naam van je werkblad
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
Je moet een paar dingen aanpassen. (in het groen aangegeven in de code van bijgevoegd voorbeeld)
Je vervangt AccessFolder met de naam van de folder waar je access bestand instaat.
Je vervangt tutDB met de echte naam van je access bestand
Je vervangt test met de echte naam van je tabel of qwery die je wilt importeren.
Je vervangt blad1 met de echte naam van het blad uit Adresgegevens.xlsx waar de gegevens naartoe moeten.
Tenslotte zorg je ervoor dat volgende is aangevinkt in de VBA editor (Alt + F11) ->Extra -> Verwijzingen. (zie plaatje)
That's it.:cool:
Als er nog vragen zijn, just ask
Zie ook excel voorbeeld,in het voorbeeld heb ik de code onder een knop gezet en de code is te vinden in de bladmodule.
(zipje , eerst uitpakken)
240487
 

Bijlagen

WiBoData

Steunend lid
Vip Lid
Beste Knoet,

hartelijk dank voor je prompte reflex en antwoord.
Je programmacode kent (voorlopig) twee statements niet of reageert verkeerd. Ik moet wel bekennen dat ik vergeten was te vermelden dat ik met de 2007 versie werk.
1: het statement "sheet" kan hij niet interpreteren (compilation error, sub of functie is niet gedefinieerd)
2: hetzelfde voor "ScreenUpdating" (kan de methode of gegevenslid niet vinden)

het zijn errors die ik constant tegen kom

met dank,
WiBoData
 

knoet

Steunend lid
Vip Lid
Beste,
Deze code werkt voor office 2010 tot en met 2019.
Voor office 2007 weet ik het niet,ik kan het ook niet testen in een 2007 versie.
Probeer het volgende
Application.ScreenUpdating = False mag je wissen.
Vervang Sheets("blad1").Range("A1") door Range("A1")
 

WiBoData

Steunend lid
Vip Lid
beste Knoet,

Het programma heeft die lijn vroeger al eens uitgevoerd, maar met objWorksheet als object<; wat me nu verontrust is dat het statement copyfromrecordset in kleine lettertjes blijft staan i.p.v. CopyFromRecordset.
Deze morgen bij het opstarten van mijn PC startte ook Excel (zonder vragen) op en ik kreeg een kleine 100 lege werkbladen, allemaal leeg en hier en daar een met resultaten van gisteren? ALLEMAAL ALLEEN LEZEN EN BEVEILIGD; waar heb ik dat aan te danken? de stekker uittrekken was het enigste dat hielp.
 
Laatst bewerkt:

WiBoData

Steunend lid
Vip Lid
beste Knoet,

Het programma heeft die lijn vroeger al eens uitgevoerd, maar met objWorksheet als object<; wat me nu verontrust is dat het statement copyfromrecordset in kleine lettertjes blijft staan i.p.v. CopyFromRecordset.
Deze morgen bij het opstarten van mijn PC startte ook Excel (zonder vragen) op en ik kreeg een kleine 100 lege werkbladen, allemaal leeg en hier en daar een met resultaten van gisteren? ALLEMAAL ALLEEN LEZEN EN BEVEILIGD; waar heb ik dat aan te danken? de stekker uittrekken was het enigste dat hielp.
 

WiBoData

Steunend lid
Vip Lid
beste Knoet,

Het programma heeft die lijn vroeger al eens uitgevoerd, maar met objWorksheet als object<; wat me nu verontrust is dat het statement copyfromrecordset in kleine lettertjes blijft staan i.p.v. CopyFromRecordset.
Deze morgen bij het opstarten van mijn PC startte ook Excel (zonder vragen) op en ik kreeg een kleine 100 lege werkbladen, allemaal leeg en hier en daar een met resultaten van gisteren? ALLEMAAL ALLEEN LEZEN EN BEVEILIGD; waar heb ik dat aan te danken? de stekker uittrekken was het enigste dat hielp.

de volgende regels heb ik nu in het programma


Function AccessToExcel()
Dim cnn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim objExcel As Object 'Excel.Application
Dim objWorkBook As Object 'Excel.Workbook
Dim objWorkSheet As Object
Dim objQuery As Object

Dim varCriterium As String
ActueelPad = Application.CurrentProject.Path & "\"

Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
Set objExcel = CreateObject("Excel.Application")
Set objWorkBook = objExcel.workbooks.Add
varNaamToExcel = ActueelPad & "\" & "adressenboekje.mdb"
cnn.CursorLocation = adUseClient
If stVoorw = "O" Then
stVoorw = ""
stDocName = "qryAdres"
rst.Open stDocName, cnn, adOpenStatic, adLockOptimistic, -1

Else
strDocName = "qryCalculatie" & strVoorw
rst.Open stDocName, cnn, adOpenStatic, adLockOptimistic, -1

End If
Set rst = cnn.Execute(strDocName, Naam, adres, PostNr, Gemeente, Telefoon)
Set objExcel = CreateObject("Excel.Application")
Set objWorkBook = objExcel.workbooks.Add
'Add data to cells of the first worksheet in the new workbook
objWorkBook.WorkSheets(1).range("A1").copyfromrecordset rst
'objExcel.range("A1").copyfromrecordset rst
objExcel.range("A1").copyfromrecordset rst
objWorkSheet.Visible = True
objWorkSheet.Activate
If MsgBox("Dit werkblad als een file opslaan?" _
& Chr(13) & Chr(10) & "druk dan 'Ja'" _
& Chr(13) & Chr(10) & "of druk 'Nee' om verder te gaan.", _
vbYesNo) = vbYes Then ' Definieert bericht.
' Response = MsgBox(Msg, Style, Title)
objWorkBook.saveas ActueelPad & "ExcelOptie" & stVoorw & ".xlsx"
Else
objExcel.Quit
End If
Close
Set rst = Nothing
cnn.Close
End Function
 
Bovenaan Onderaan