Einzelne Adressen aus Access importieren
27.07.2006 14:55:59
Boris
noch ein Neuer und direkt ne dumme Frage;-)
Meine Holde muss ofters Rechnungen schreiben. Am einfachsten ist das ja nunmal mit Excel. Ich hab zwar ein Programm daß nur dafür gemacht ist, aber das will sie nicht nutzen(wieso auch immer)
Den Kundenstamm würde ich ihr gerne in eine Access-DB unterbringen. Jetzt muss ich nur noch möglichst einfach diese Kunden in das "Rechnungs- Sheet" importieren. Natürlich sollte sie sich diesen Kunden am besten per klick aussuchen können. Aber Name sollte auch funktionieren. Dieser soll dann wie gesagt in die Rechnung importiert werden. Und zwar so:
Name Vorname
Strasse
Plz Ort
Diesen Code hab ich schon bekommen und versucht meinen Wünschen anzupassen. Allerdigs schreibt er dei Daten nicht so in das Sheet wie ich es gerne hätte.
Excel ist bis jetzt mein Sorgenkind, und VBA in Excel auch nicht meine Stärke.
Könnte mir mal einer auf die Sprünge helfen wie ich das hinbekomme?
Sub Schaltfläche1_BeiKlick()
' Achtung der Verweis auf: Microsoft ActiveX Data Objects 2.0 Library
' oder eine höhere Version (2.1, 2.5) muss aktiviert sein.
' Hier soll eine Access-Datenbank, die passwortgeschützt ist gelesen werden.
' Achtung: Die Namen in Access dürfen keinen Bindestrich, sondern immer
' den Unterstrich als Text-Trennung enthalten - z. B. PSTLZ_Straße.
Dim Connect As Connection ' die Verbindung zu Access
Dim RecSet As Recordset ' der Access RecordSet
Dim SQLString As String ' der SQL Befehl
Dim Ziel As Worksheet ' Excel-Tabellenblatt
Dim Zeile As Integer ' Zeile
Dim Spalte As Integer ' Spalte
Dim DBPfad As String ' Pfad der Access-Anwendung
Dim DBDatei As String ' Name der Access-Datei bzw. DB
Dim DBTab As String ' Name der Access-Tabelle
Dim Suchbegr As String ' String als Suchbegriff
DBPfad = "E:\"
DBDatei = "Kunden.mdb"
DBTab = "Kunden"
Set Ziel = Worksheets("Rechnung") ' Ziel Tabellenblatt in Excel
' Die Datenbank öffnen
Set Connect = New ADODB.Connection
With Connect ' für Access 2000 und höhere '~~~~~~~~~~~~~~~~
.Provider = "Microsoft.Jet.OLEDB.4.0" + ";Jet OLEDB:Database Password=welcome"
.ConnectionString = "Data Source=" & DBPfad & DBDatei '~~~~~~~~~~~~~~~~
.Open
End With
' im SQL-String definieren was geholt werden soll => hier verschiedene Varianten
' hier alles - die komplette Access-Tabelle
'SQLString = "SELECT Adressen.* FROM Adressen" ' <-- Hier die Datenbanktabelle
SQLString = "SELECT " & DBTab & _
".* FROM " & DBTab & "" ' <-- Hier die Datenbanktabelle
If SQLString = "" Then
MsgBox "hier ist der Wurm drin, der SQLString ist leer - Abbruch.", _
16, " der SQLString wurde nicht gefüllt."
Exit Sub
Else
'MsgBox SQLString ' den SQL-String anzeigen
End If
Set RecSet = New ADODB.Recordset
RecSet.Open SQLString, Connect, adOpenDynamic, adLockReadOnly
Cells.ClearContents ' den alten Inhalt löschen
'Call Kopf_entfaerben ' die alten Kopfzeilen entfernen
Application.ScreenUpdating = False
' Die Feldnamen der Datenbanktabelle in die erste Zeile des
' Excel Ziel-Tabellenblattes schreiben
For Spalte = 0 To RecSet.Fields.Count - 1
Ziel.Cells(5, Zeile + 1) = RecSet.Fields.Item(Spalte).Name
Next Spalte
'Call Kopf_farbig(RecSet.Fields.Count) ' die neuen Kopfzeilen farbig, fett
' Jetzt alle selektierten Sätze holen und in das Excel-Tabellenblatt schreiben
Zeile = 1
If RecSet.EOF = False Then ' kein EOF => es gibt also Daten !
RecSet.MoveFirst ' auf dem ersten Datensatz aufsetzen
Else
MsgBox "es konnte nichts selektiert werden => Abbruch.", _
16, " fehlerhafte Selektion ?"
Exit Sub
End If
Do While RecSet.EOF = False
Zeile = Zeile + 1
For Spalte = 0 To RecSet.Fields.Count - 1
If IsNull(RecSet.Fields.Item(Spalte).Value) = False Then
Ziel.Cells(Zeile, Spalte + 1) = RecSet.Fields.Item(Spalte).Value
Ziel.Rows(Zeile & ":" & Zeile).RowHeight = 13.2
End If
Next Spalte
RecSet.MoveNext
Loop
Cells.EntireColumn.AutoFit
[A1].Select
Application.ScreenUpdating = True
RecSet.Close
Connect.Close
End Sub