Χρήση Vba για την πρόσβαση σε βάση δεδομένων

Εισηγητής: Μπαλατσούκας Νίκος

Sub test_()
'Declaring the necessary variables.
Dim con As Object
Dim rs As Object
Dim sql As String
Dim myValues() As String
Dim i As Integer
Dim j As Integer

'Disable screen flickering.
Application.ScreenUpdating = False

On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Check if the object was created.
If Err.Number <> 0Then
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0

'Open the connection.
'Όλα σε μια γραμμή:
con.Open
"Provider=Microsoft.ACE.OLEDB.12.0;
Data Source=
C:UsersnikosDesktopdbnikos.accdb;"

'Create the SQL statement to read the file.
Filter all the data from Canada.
'Note that the filename is used instead of the
table name.
sql = "SELECT * FROM nikos"

On Error Resume Next
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.recordset")
'Check if the object was created.
If Err.Number <> 0Then
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0

'Set thee cursor location.
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'Open the recordset.
rs.Open sql, con
'Redim the table that will contain the filtered data.
ReDim myValues(rs.RecordCount, 4)

'Loop through the recordset and pass the
selected values to the array.
i = 1

If Not (rs.EOFAnd rs.BOF)Then
'Go to the first record.
rs.MoveFirst
Do Until rs.EOF =True
myValues(i, 1) = rs!onoma
'Move to the next record.
rs.MoveNext
i = i + 1
Loop
Else

Else
'Close the recordet and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing
'Enable the screen.
Application.ScreenUpdating =True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If

'Write the array in the sheet.
'Sheet1.Activate
For i = 1To UBound(myValues)
For j = 1To 4
Cells(i + 1, j) = myValues(i, j)
Next j
Next i

'Close the recordet and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing

'Adust the columns width.
Columns("A:D").EntireColumn.AutoFit
'Enable the screen.
Application.ScreenUpdating =True

'Inform the user that the macro was executed
successfully.
MsgBox "The values were read from recordset
successfully!", vbInformation, "Done"
End Sub

Χρήση Vba για την πρόσβαση σε βάση δεδομένων

More Related Content

What's hot (8)

Similar to Χρήση Vba για την πρόσβαση σε βάση δεδομένων (20)

More from Nikos Mpalatsoukas (20)

Recently uploaded (20)

Χρήση Vba για την πρόσβαση σε βάση δεδομένων