Public Sub ImportData()

' ... Bitte setzen Sie unter Extras/Verweise
'     einen Verweis auf "Microsoft DAO 3.6 Object Libary"

' ... Database-Objects
Dim dbData As Database
Dim rsData As Recordset

Dim layImport As rgLayer

' ... Vergleichspalten
Dim rgMatchCol As Integer
Dim ExcelMatchCol As Long

Dim lObjectIndex As Long
Dim vValueRef As Variant

Dim vNewData As Variant
Dim j As Long

' ... Layer anhand des Names suchen       .....Layername.....
Set layImport = project.SearchLayerByName("Deutschland Kreise")
If Not layImport.Loaded Then
    MsgBox "Layer nicht geladen"
    Exit Sub
End If

' ... Suchspalte im Importlayer
rgMatchCol = 0
' ... MatchColIndex from Excel-Sheet
ExcelMatchCol = 0

' ... Wenn nötig können mit dieser Function alle Daten im Layer gelöscht werden.

'DeleteLayerData layImport

' ... Daten von EXCEL     ...Pfad zur Exceldatei
Set dbData = OpenDatabase("D:\RegioGraph Makros\Data\ExcelImport.xls", False, True, "Excel 5.0;") 'or Excel 8.0
'                           ... ExcelTabellen-Name
Set rsData = dbData.OpenRecordset("Tabelle1$")

' ... Alle Datensätze der EXCEL-Tabelle durchlaufen
Do Until rsData.EOF
    ' ... Leere Felder ignorieren
    If Not IsNull(rsData(ExcelMatchCol)) Then

        ' ... Daten der Excel-Referenzspalte
        vValueRef = rsData(ExcelMatchCol)
        ' ... Suche diesen Datensatz RegioGraph-Layer
        lObjectIndex = layImport.FindValue(rgMatchCol, vValueRef)
        If lObjectIndex > -1 Then
            ' ... Wenn ein Objekt gefunden wurde
                ' ... Achtung: Spaltenzählung beginnt immer bei 0
                ' ... Daten aus 2. Excel Spalte
                vNewData = rsData(1)

                ' ... Import in 4. RegioGraph-Spalte
                layImport.SetValue lObjectIndex, 3, vNewData
                           
                ' ... Daten aus 3. Excel Spalte
                vNewData = rsData(2)
                ' ... Import in 5. RegioGraph-Spalte
                layImport.SetValue lObjectIndex, 4, vNewData
               
                ' ... Mögliche weitere Datenspalten
'                    ' ... Daten aus 4. Excel Spalte

'                    vNewData = rsData(3)
'                    ' ... Import in 6. RegioGraph-Spalte
'                    layImport.SetValue lObjectIndex, 4, vNewData

'                    ' ... Daten aus 5. Excel Spalte
'                    vNewData = rsData(4)
'                    ' ... Import in 7. RegioGraph-Spalte
'                    layImport.SetValue lObjectIndex, 4, vNewData
       
        Else
            ' ... Wenn keine Übereinstimmung gefunden wurde Meldung

            MsgBox "Data: " & vValueRef & " hat keine Übereinstimmung mit RG-Abgleichspalte!"
        End If
    End If
    ' ... Nächster Excel-Datensatz
    rsData.MoveNext
Loop

' ... Hier kann Layer dann mit neuen Daten abgespeichert werden
'layImport.Save

Set layImport = Nothing

Set dbData = Nothing
Set rsData = Nothing

' ... Wenn eine Karte aktiv diese neu zeichnen

If Not ActiveMap Is Nothing Then
    ActiveMap.Refresh
End If

MsgBox "Datenimport beendet"

End Sub