VBA og SQL kan være en god kombi når man vil hente data fra Acces Db til Excel 

God Video her :

https://www.youtube.com/watch?v=HE9CIbetNnI

 

Kode eksempel:

 

Sub CopyDataFromDatabase()

Dim Moviesconn As ADODB.Connection
Dim MoviesData As ADODB.Recordset
Dim MoviesField As ADODB.Field


Set Moviesconn = New ADODB.Connection
Set MoviesData = New ADODB.Recordset

Moviesconn.ConnectionString = ConstAcces
Moviesconn.Open

With MoviesData

.ActiveConnection = Moviesconn
'.Source = "SELECT OrderID,CustomerID,OrderDate FROM Orders where quantity>10"
.Source = GetSqlString
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
Worksheets.Add

For Each MoviesField In MoviesData.Fields
ActiveCell.Value = MoviesField.Name
ActiveCell.Offset(0, 1).Select
Next MoviesField

Range("A2").CopyFromRecordset MoviesData
Range("A1").CurrentRegion.EntireColumn.AutoFit

MoviesData.Close
Moviesconn.Close

End Sub


Function GetSqlString() As String

Dim UserInput As Integer
Dim SQLString As String


UserInput = Application.InputBox("Enter Value", Type:=1)

SQLString = "SELECT OrderID,CustomerID,OrderDate FROM Orders where quantity> " & UserInput & ""

GetSqlString = SQLString


End Function

 

Option Explicit

'Const ConstAcces As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=G:\Tid.accdb;Persist Security Info=False; "

'C:\Users\w20647\Desktop\Upload Center\10 Udviklingsopgaven\Tid.accdb

Const ConstAcces As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\w20647\Desktop\Upload Center\10 Udviklingsopgaven\Tid.accdb;Persist Security Info=False; "


'Links
'omdøb nyt sheet
'https://www.youtube.com/watch?v=1wgk6Pavp_w

'VBA SqlQueries
'https://www.youtube.com/watch?v=HE9CIbetNnI
'https://www.youtube.com/watch?v=HE9CIbetNnI
'https://www.youtube.com/watch?v=c2_fEdFBj_Q

'insert sql
'https://www.youtube.com/watch?v=-c2QvyPpkAM

Sub CopyDataFromDatabase()

Dim TidConn As ADODB.Connection
Dim TidData As ADODB.Recordset
Dim TidField As ADODB.Field
Dim Rapport As Worksheet
Dim xWs As Worksheet
Dim sheetName As String
sheetName = "Rapport"
'Under sheetname defineres hvilket ark der skal testes og slettes

Set TidConn = New ADODB.Connection
Set TidData = New ADODB.Recordset

'Sheets("Rapport").Delete

'Start slet faneblad Rapport hvis der faneblad existerer

Application.DisplayAlerts = False
Err.Clear
On Error Resume Next

Set xWs = Sheets(sheetName)

If Err <> 0 Then
MsgBox "The'" & sheetName & "'" & "does not exist!", vbInformation, "Kutools for Excel"
GoTo FortsaetUdenSlet

Exit Sub
Else
xWs.Delete
MsgBox "The'" & sheetName & "'" & "has been deleted!", vbInformation, "Kutools for Excel"
End If
Application.DisplayAlerts = True

'Slut slet faneblad Rapport hvis der faneblad existerer

'Hvis faneblad Rapport ikke eksisterer og ikke skal slettes så fortsæt her
FortsaetUdenSlet:

 

TidConn.ConnectionString = ConstAcces
TidConn.Open

With TidData

.ActiveConnection = TidConn
.Source = GetSqlString_CFD
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With


Worksheets.Add

Sheets(ActiveSheet.Name).Name = "Rapport"

For Each TidField In TidData.Fields
ActiveCell.Value = TidField.Name
ActiveCell.Offset(0, 1).Select
Next TidField

Range("A2").CopyFromRecordset TidData
Range("A1").CurrentRegion.EntireColumn.AutoFit

TidData.Close
TidConn.Close

End Sub

'Funktion hvor bruger kan udspecificere projektnummer
Function GetSqlString_CFD() As String

Dim UserInput As Integer
Dim SQLString As String


UserInput = Application.InputBox("Enter Value", Type:=1)

SQLString = "SELECT * FROM Forbrug where F= " & UserInput & ""

GetSqlString_CFD = SQLString


End Function