title image


Smiley Eine wirklich fertige Lösung ist's nicht...
(und ich weiss auch nicht, ob die Satzstruktur noch aktuell ist - die Routinen beziehen sich auf die Datafactory Daten vom März 2001):



Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

Public Function OEMToAnsiStr(S)

Dim RetVal As Long, Res As String

On Error GoTo Er

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



Ex:

Exit Function



Er:

MsgBox Error$

Resume Ex



End Function





Public Function KG(Optional FName = "E:\Eigene Dateien\Diverses\Post\G0103026.dat")

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



Public Function zN(Z, Optional ValueIfNull = "")

If Z = ValueIfNull Then

zN = Null

Else

zN = Z

End If

End Function



Public Function ORT(Optional FName = "E:\Eigene Dateien\Diverses\Post\G0103026.dat")

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



Public Function PLZ(Optional FName = "E:\Eigene Dateien\Diverses\Post\G0103026.dat")

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



Public Function Stra(Optional FName = "E:\Eigene Dateien\Diverses\Post\G0103026.dat")

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





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";





Gruß aus dem Norden
Reinhard


Bitte immer die Access-Version angeben!
DB-Wiki


Wie man Fragen richtig stellt

YaccessAccess-FAQUnd ansonsten: Wikipedia




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: