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