Hallo,
ich bin recht neu bei VBA. Ich bin jetzt dabei, eine kleine Anwendung für Excel zu basteln, in der unter anderem Adressen eingegeben werden. Da bietet sich eine kleine Datenbank zum Hinzufügen, bzw. Auslesen der Adressen geradezu an. Leider hab ich keinen Schimmer, wie ich vorgehen soll.
Hat jemand eine Idee?
Vielen Dank erstmal
Dieter
Hallo,
hier nur ein VBA-Auszug aus einem Test-VBA-WordDokument.
Öffenen einer Datenbank über ODBC (z.B. Access-DB,…), suchen von Daten und einfache Darstellung in einer Listbox.
Das Coding wird einfach so NICHT funktionieren, da es ein UserForm braucht und ein paar Controls, aber zum Angucken reichts allemal!!
Weiters wirst Du (in diesem Fall) die „Microsoft ActiveX Data Objects“ unter „Extras/Verweise“ einschalten müssen!! Und nicht zu vergessen in der Systemsteuerung unter ODBC-Datenquelle die Datenbank einrichten!!!
greets from MichL (Vienna)
Option Explicit
'DefSng
'DefDbl
'DefDec
'DefByte
DefBool B
DefInt I
DefInt F 'File-Handle
DefLng L
DefLng H 'Windows-Handle
DefCur C
DefDate D
DefStr S
DefObj O
DefVar V
'
Private conmHelpDesk As ADODB.Connection
'
Public blnmErrorOnForm
'
'
Private Sub txtSearch\_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim recK As ADODB.Recordset
Dim lngCnt As Long
'
'
If KeyCode = 13 Then
Call Me.lstResult.Clear
Set recK = Me.SearchKundenAnsprechpartner(Me.txtSearch.Text, "", ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockReadOnly)
If Me.NothingOrEOF(recK) Then
Me.lblStatus.Caption = " Sorry, no entries found!!"
Exit Sub
End If
'
While Not NothingOrEOF(recK)
Call Me.lstResult.AddItem(recK!Name1 & " " & recK!Name2 & vbCrLf & recK!Nachname & " " & recK!Vorname)
lngCnt = lngCnt + 1
Call recK.MoveNext
Wend
Me.lblStatus.Caption = " " & lngCnt & " entries found!!"
'
Call Me.CloseRecordSet(recK)
End If
'
End Sub
'
Public Function SearchKundenAnsprechpartner(strSearch, strTeilwort, CursorType As Integer, LockType As Integer) As ADODB.Recordset
Dim rec As ADODB.Recordset
Dim strSQL
'
'SQL-Abfrage zusammenstellen
strSQL = strSQL & "SELECT tabKunden.Nr AS [KNr], tabKunden.KurzBez, tabKunden.Name1, tabKunden.Name2, tabKunden.Name3, tabAnsprechpartner.Nr AS [ANr], tabAnsprechpartner.Vorname, tabAnsprechpartner.Nachname "
strSQL = strSQL & "FROM tabKunden LEFT JOIN tabAnsprechpartner ON tabKunden.Nr = tabAnsprechpartner.tabKundeNr "
strSQL = strSQL & "WHERE tabKunden.Name1 LIKE '" & strTeilwort & strSearch & "%' "
strSQL = strSQL & "OR tabKunden.Name2 LIKE '" & strTeilwort & strSearch & "%' "
strSQL = strSQL & "OR tabKunden.Name3 LIKE '" & strTeilwort & strSearch & "%' "
strSQL = strSQL & "OR tabKunden.KurzBez LIKE '" & strTeilwort & strSearch & "%' "
strSQL = strSQL & "OR tabAnsprechpartner.Nachname LIKE '" & strTeilwort & strSearch & "%' "
strSQL = strSQL & "OR tabAnsprechpartner.Vorname LIKE '" & strTeilwort & strSearch & "%';"
'
Set rec = New ADODB.Recordset
Call rec.Open(strSQL, conmHelpDesk, CursorType, LockType)
'
Set SearchKundenAnsprechpartner = rec
Set rec = Nothing
'
End Function
'
'
Private Sub UserForm\_Initialize()
Dim strBuf
'
On Error GoTo ErrorHandler
Set conmHelpDesk = New ADODB.Connection
Call conmHelpDesk.Open("OdbcHelpDesk")
'
'
ExitHandler:
On Error GoTo 0
Exit Sub
'
'
ErrorHandler:
strBuf = strBuf & "Can't open HelpDesk database!!!" & vbCrLf & vbCrLf
strBuf = strBuf & "Please check if the ODBC-DataSourceName 'OdbcHelpDesk' and the ODBC-Database exists!!!" & vbCrLf
'
Call MsgBox(strBuf)
blnmErrorOnForm = True
Resume ExitHandler
'
End Sub
'
Private Sub UserForm\_QueryClose(Cancel As Integer, CloseMode As Integer)
'
Call conmHelpDesk.Close
'
End Sub
'
Public Function NothingOrEOF(rec As ADODB.Recordset) As Boolean
'
NothingOrEOF = True
'
If rec Is Nothing Then Exit Function
If rec.EOF Then Exit Function
'
NothingOrEOF = False
'
End Function
'
Public Sub CloseRecordSet(rec As ADODB.Recordset)
'
On Error Resume Next
If Not rec Is Nothing Then Call rec.Close
On Error GoTo 0
'
Set rec = Nothing
'
Exit Sub
'
End Sub
Vielen Dank für die schnelle Antwort, ich werd’s ausprobieren!
Dieter