VBA Tipp: Datafactory Postalcode - Postleitdaten konvertieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich habe die "Datafactory Postalcode"-CD mit den Postleitdaten der Deutschen Post erworben, kann aber mit der darauf befindlichen Daten-Datei nichts anfangen.

Lösung

Die folgenden Funktionen konvertieren die verschieden langen Datensätze der Daten-Datei in Access-Datenbanktabellen:

Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" _
  (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
 
Private Function OEMToAnsiStr(S)
Dim RetVal As Long, Res As String
  If IsNull(S) Then
     OEMToAnsiStr = Null
  Else
    Res = String(Len(S) + 1, 0)
    RetVal = OemToChar(S, Res)
    OEMToAnsiStr = Mid$(Res, 1, Len(S))
  End If
End Function
 
Private Function KG(FName As String)
Dim Tmp, RS As Recordset, DB As Database
Set DB = CurrentDb
DB.Execute "DELETE FROM KG"
Set RS = DB.OpenRecordset("KG")
  Open FName For Input As #1
  Do
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) = "KG"
  Do
    RS.AddNew
    RS!KGVersion = Mid(Tmp, 1, 9)
    RS!KGDatum = Mid(Tmp, 10, 8)
    RS!KGSchluessel = Mid(Tmp, 18, 8)
    RS!KGSA = Mid(Tmp, 26, 1)
    RS!KGName = Trim(OEMToAnsiStr(Mid(Tmp, 27, 40)))
    RS.Update
'    Debug.Print Tmp
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) <> "KG"
  Close
End Function
 
Private Function zN(Z, Optional ValueIfNull = "")
If Z = ValueIfNull Then
  zN = Null
Else
  zN = Z
End If
End Function
 
Private Function ORT(FName As String)
Dim Tmp, RS As Recordset, DB As Database
Set DB = CurrentDb
DB.Execute "DELETE FROM ORT"
Set RS = DB.OpenRecordset("ORT")
  Open FName For Input As #1
  Do
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) = "OR"
  Do
    RS.AddNew
    RS!ORTVersion = Mid(Tmp, 1, 9)
    RS!ORTDatum = Mid(Tmp, 10, 8)
    RS!ORTALORT = Mid(Tmp, 18, 8)
    RS!ORTStatus = zN(Mid(Tmp, 26, 1))
    RS!ORTOName = zN(Trim(OEMToAnsiStr(Mid(Tmp, 27, 40))))
    RS!ORTONamePost = zN(Trim(OEMToAnsiStr(Mid(Tmp, 67, 40))))
    RS!ORTOZusatz = zN(Trim(OEMToAnsiStr(Mid(Tmp, 107, 30))))
    RS!ORTArtOZusatz = zN(Mid(Tmp, 137, 1))
    RS!ORTOName24 = zN(Trim(OEMToAnsiStr(Mid(Tmp, 138, 24))))
    RS!ORTKGS = zN(Mid(Tmp, 162, 8))
    RS!ORTALORTNeu = zN(Mid(Tmp, 170, 8))
    If Mid(Tmp, 178, 1) <> "$" Then
      Exit Do
    End If
   RS.Update
'    Debug.Print Tmp
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) <> "OR"
  Close
End Function
 
Private Function PLZ(FName As String)
Dim Tmp, RS As Recordset, DB As Database
Set DB = CurrentDb
DB.Execute "DELETE FROM PLZ"
Set RS = DB.OpenRecordset("PLZ")
  Open FName For Input As #1
  Do
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) = "PL"
  Do
    RS.AddNew
    RS!PLZVersion = Mid(Tmp, 1, 9)
    RS!PLZDatum = Mid(Tmp, 10, 8)
    RS!PLZPLZ = Mid(Tmp, 18, 5)
    RS!PLZALORT = Mid(Tmp, 23, 8)
    RS!PLZArtKardinalitaet = zN(Mid(Tmp, 31, 1))
    RS!PLZArtAuslieferung = zN(Mid(Tmp, 32, 1))
    RS!PLZStVerz = zN(Mid(Tmp, 33, 1))
    RS!PLZPFVerz = zN(Mid(Tmp, 34, 1))
    RS!PLZOName = zN(Trim(OEMToAnsiStr(Mid(Tmp, 35, 40))))
    RS!PLZOZusatz = zN(Trim(OEMToAnsiStr(Mid(Tmp, 75, 30))))
    RS!PLZArtOZusatz = zN(Mid(Tmp, 105, 1))
    RS!PLZOName24 = zN(Trim(OEMToAnsiStr(Mid(Tmp, 106, 24))))
    RS!PLZPostlag = zN(Mid(Tmp, 130, 1))
    RS!PLZLABrief = zN(Mid(Tmp, 131, 8))
    RS!PLZLAALORT = zN(Mid(Tmp, 139, 8))
    RS!PLZKGS = zN(Mid(Tmp, 147, 8))
    RS!PLZOrtCode = zN(Mid(Tmp, 155, 3))
    RS!PLZLeitcodeMax = zN(Mid(Tmp, 158, 3))
    RS!PLZRabattInfoSchwer = zN(Mid(Tmp, 161, 1))
    RS!PLZFZNr = zN(Mid(Tmp, 164, 2))
    RS!PLZBZNr = zN(Mid(Tmp, 166, 2))
    If Mid(Tmp, 168, 1) <> "$" Then
      Exit Do
    End If
   RS.Update
'    Debug.Print Tmp
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) <> "PL"
  Close
End Function
 
Private Function Stra(FName As String)
Dim Tmp, RS As Recordset, DB As Database
Set DB = CurrentDb
DB.Execute "DELETE FROM STR"
Set RS = DB.OpenRecordset("STR")
  Open FName For Input As #1
  Do
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) = "ST"
  Do
    RS.AddNew
    RS!STRVersion = zN(Trim(Mid(Tmp, 1, 9)))
    RS!STRDatum = zN(Trim(Mid(Tmp, 10, 8)))
    RS!STRALORT = zN(Trim(Mid(Tmp, 18, 8)))
    RS!STRNamenSchl = zN(Trim(Mid(Tmp, 26, 6)))
    RS!STRBundLfdNr = zN(Trim(Mid(Tmp, 32, 5)))
    RS!STRHNrVon = zN(Trim(Mid(Tmp, 37, 8)))
    RS!STRHNrBis = zN(Trim(Mid(Tmp, 45, 8)))
    RS!STRStatus = zN(Trim(Mid(Tmp, 53, 1)))
    RS!STRHNr1000 = zN(Trim(Mid(Tmp, 54, 1)))
    RS!STRStVerz = zN(Trim(Mid(Tmp, 55, 1)))
    RS!STRNameSort = zN(Trim(Mid(Tmp, 56, 46)))
    RS!STRNameE46 = zN(Trim(OEMToAnsiStr(Mid(Tmp, 102, 46))))
    RS!STRNameE22 = zN(Trim(OEMToAnsiStr(Mid(Tmp, 148, 22))))
    RS!STRRes = zN(Trim(Mid(Tmp, 170, 1)))
    RS!STRHNrTyp = zN(Trim(Mid(Tmp, 171, 1)))
    RS!STRPLZ = zN(Trim(Mid(Tmp, 172, 5)))
    RS!STRCode = zN(Trim(Mid(Tmp, 177, 3)))
    RS!STROrtSchl = zN(Trim(Mid(Tmp, 180, 3)))
    RS!STRALOrgB = zN(Trim(Mid(Tmp, 183, 8)))
    RS!STRKGS = zN(Trim(Mid(Tmp, 191, 8)))
    RS!STRALOrtNeu = zN(Trim(Mid(Tmp, 199, 8)))
    RS!STRNamenSchlNeu = zN(Trim(Mid(Tmp, 207, 6)))
    RS!STRBundLfdNrNeu = zN(Trim(Mid(Tmp, 213, 5)))
    RS!STRHNrVonNeu = zN(Trim(Mid(Tmp, 218, 8)))
    RS!STRHNrBisNeu = zN(Trim(Mid(Tmp, 226, 8)))
    If Mid(Tmp, 234, 1) <> "$" Then
      Exit Do
    End If
   RS.Update
   DoEvents
'    Debug.Print Tmp
    Line Input #1, Tmp
  Loop Until Mid(Tmp, 1, 2) <> "ST" Or EOF(1)
  Close
End Function
 
Public Sub Convert(FName As String)
  Call KG ( FName)
  Call ORT (FName)
  Call Stra (FName)
  Call PLZ (FName)
End Sub

Mit folgenden Tabellendefinitionen (DDL):

CREATE TABLE "KG"
(
    "ID" Counter NOT NULL ,
    "KGVersion" CHAR( 9) ,
    "KGDatum" CHAR( 50) ,
    "KGSchluessel" CHAR( 8) ,
    "KGSA" CHAR( 1) ,
    "KGName" CHAR( 40) ,
    PRIMARY KEY "ID"
);
CREATE UNIQE INDEX "KG_PK" ON "KG" ("ID" ASC );
 
CREATE TABLE "ORT"
(
    "ID" Counter NOT NULL ,
    "ORTVersion" CHAR( 9) ,
    "ORTDatum" CHAR( 50) ,
    "ORTALORT" CHAR( 8) ,
    "ORTStatus" CHAR( 1) ,
    "ORTOName" CHAR( 40) ,
    "ORTONamePost" CHAR( 40) ,
    "ORTOZusatz" CHAR( 30) ,
    "ORTArtOZusatz" CHAR( 1) ,
    "ORTOName24" CHAR( 24) ,
    "ORTKGS" CHAR( 8) ,
    "ORTALORTNeu" CHAR( 8) ,
    PRIMARY KEY "ID"
);
CREATE UNIQE INDEX "ORT_PK" ON "ORT" ("ID" ASC );
 
CREATE TABLE "PLZ"
(
    "ID" Counter NOT NULL ,
    "PLZVersion" CHAR( 9) ,
    "PLZDatum" CHAR( 50) ,
    "PLZPLZ" CHAR( 5) ,
    "PLZALORT" CHAR( 8) ,
    "PLZArtKardinalitaet" CHAR( 1) ,
    "PLZArtAuslieferung" CHAR( 1) ,
    "PLZStVerz" CHAR( 1) ,
    "PLZPFVerz" CHAR( 1) ,
    "PLZOName" CHAR( 40) ,
    "PLZOZusatz" CHAR( 30) ,
    "PLZArtOZusatz" CHAR( 1) ,
    "PLZOName24" CHAR( 24) ,
    "PLZPostlag" CHAR( 1) ,
    "PLZLABrief" CHAR( 8) ,
    "PLZLAALORT" CHAR( 8) ,
    "PLZKGS" CHAR( 8) ,
    "PLZOrtCode" CHAR( 3) ,
    "PLZLeitcodeMax" CHAR( 3) ,
    "PLZRabattInfoSchwer" CHAR( 1) ,
    "PLZFZNr" CHAR( 2) ,
    "PLZBZNr" CHAR( 2) ,
    PRIMARY KEY "ID"
);
CREATE UNIQE INDEX "PLZ_PK" ON "PLZ" ("ID" ASC );
 
CREATE TABLE "STR"
(
    "ID" Counter NOT NULL ,
    "STRVersion" CHAR( 9) ,
    "STRDatum" CHAR( 8) ,
    "STRALORT" CHAR( 8) ,
    "STRNamenSchl" CHAR( 6) ,
    "STRBundLfdNr" CHAR( 5) ,
    "STRHNrVon" CHAR( 8) ,
    "STRHNrBis" CHAR( 8) ,
    "STRStatus" CHAR( 1) ,
    "STRHNr1000" CHAR( 1) ,
    "STRStVerz" CHAR( 1) ,
    "STRNameSort" CHAR( 46) ,
    "STRNameE46" CHAR( 46) ,
    "STRNameE22" CHAR( 22) ,
    "STRRes" CHAR( 1) ,
    "STRHNrTyp" CHAR( 1) ,
    "STRPLZ" CHAR( 5) ,
    "STRCode" CHAR( 3) ,
    "STROrtSchl" CHAR( 3) ,
    "STRALOrgB" CHAR( 8) ,
    "STRKGS" CHAR( 8) ,
    "STRALOrtNeu" CHAR( 8) ,
    "STRNamenSchlNeu" CHAR( 6) ,
    "STRBundLfdNrNeu" CHAR( 5) ,
    "STRHNrVonNeu" CHAR( 8) ,
    "STRHNrBisNeu" CHAR( 8) ,
    PRIMARY KEY "ID"
);
CREATE UNIQE INDEX "STR_PK" ON "STR" ("ID" ASC );
 
CREATE TABLE "Strasse"
(
    "STRALORT" CHAR( 8) ,
    "STRHNrVon" CHAR( 8) ,
    "STRHNrBis" CHAR( 8) ,
    "STRName" CHAR( 46) ,
    "STRHNrTyp" CHAR( 1) ,
    "STRPLZ" CHAR( 5) ,
    "STRKGS" CHAR( 8) ,
    "STRStatus" CHAR( 1)
);
COMMENT ON COLUMN "Strasse"."STRALORT" IS "Ort AlpharNr - Ortszuordnung der Post";
COMMENT ON COLUMN "Strasse"."STRHNrVon" IS "Hausnummer von";
COMMENT ON COLUMN "Strasse"."STRHNrBis" IS "Hausnummer bis";
COMMENT ON COLUMN "Strasse"."STRName" IS "Strassenname";
COMMENT ON COLUMN "Strasse"."STRHNrTyp" IS "N = Nicht geteilte Straße G = nur gerade HNrn U = nur ungerade HNrn";
COMMENT ON COLUMN "Strasse"."STRPLZ" IS "Postleitzahl";
COMMENT ON COLUMN "Strasse"."STRKGS" IS "Kreis-Gemeinde-Schlüssel";
COMMENT ON COLUMN "Strasse"."STRStatus" IS "G = gültig S, N = Schlüsseländerungen , W= aufgehoben";