Datenimport aus Datenbank

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

Benutzerdefinierter Typ nicht definiert

Dim dbData As Database
Dim rsData As Recordset

Import: Spielt Daten über ein Abgleichfeld in vorhandene "geo Objekte"

...
   ...
      ...    
Set abgleichLayer = project.SearchLayerByName("Deutschland PLZ(5)-Geb. 2004")
...
   ... Do ...
      ...
lObjectIndex = abgleichLayer.FindValue(rgMatchCol, vValueRef)
...
    ...
       ...
ObjectIndexX = abgleichLayer.GetRandomPoint(zeile).X
ObjectIndexY = abgleichLayer.GetRandomPoint(zeile).Y
...
   ...
      ...
       layImport.InsertGeoPoint ObjectIndexX, ObjectIndexY <- und die Punkte werden nicht Direkt dort gesetzt wo diese seien sollten
                z.B. Alles 5XXXX PLZ der macht mir aber die Punkte in Berlin und Schsen

                layImport.SetValue sWert, zeile, rsData(2) \
                layImport.SetValue sWert, zeile, rsData(3)--- allerdings schmeist er mir hier eine Fehlermeldung ab ( zeile  =  2 )
      ...
   ...
rsData.MoveNext
Loop
...

Dim cp as cpoint

.....
Set cp = clay.GetRandomPoint(1)

claynew.InsertGeoPoint cp.X, cp.Y