Archiv des LibreOffice- und OpenOffice.org-Wiki

[ÜberSicht] [TitelIndex] [WortIndex] [SeiteFinden

(./) OOo2

Windows®-Kontakte importieren

Das Basicmakro Kontakte_OOoAdr kann alle Adressen aus Windows®-Kontakte ins OOo-Adressbuch importieren bzw. aktualisieren.

Zuerst wird eine Verbindung zur OOo-Adressbuchtabelle aufgebaut.
Dann werden alle Kontaktdateien aus dem Windows®-Kontakte-Verzeichnis eingelesen.
Jede Kontaktdatei wird ...

Kontakte_OOoAdr.bas

Vor der ersten Benutzung:

SUB Kontakte_OOoAdr

' Aufgabe dieses Makros:
' Adressen aus Windows-Kontakte nach Office-Adressbuch kopieren

' Datenbank und Tabelle des OOo-Adressbuchs
CONST OOoAdressen = "OOo_Adressbuch"
CONST OOoTabelle = "OOo_Kontakte"

' Suchpfad für Windows-Kontakte (Vista)
CONST Suchpfad = "C:\Users\Benutzername\Contacts\"

' Deklaration der Datenbankobjekte
DIM DatabaseContext AS OBJECT
DIM DataSource AS OBJECT
DIM Connection AS OBJECT
DIM InteractionHandler AS OBJECT
DIM Statement AS OBJECT
DIM ResultSet AS OBJECT

' Temporäre Variablen
DIM SQL_Befehl AS STRING
DIM Dateiname AS STRING
DIM Dateinummer AS INTEGER
DIM Dateitext AS STRING
DIM Dateizeile AS STRING
DIM Dateiposition AS INTEGER
DIM Collectionanfang AS INTEGER
DIM Collectionende AS INTEGER
DIM Taganfang AS INTEGER
DIM Tagende AS INTEGER
DIM Labelanfang AS INTEGER
DIM Labelende AS INTEGER
DIM Zeilenanfang AS INTEGER
DIM Zeilenende AS INTEGER
DIM Textzeile AS STRING
DIM Kontaktwert(10) AS STRING
DIM Kontaktlabel(10) AS STRING

DIM Vorname AS STRING
DIM Nachname AS STRING
DIM Anzeigename AS STRING
DIM Firma AS STRING
DIM Abteilung AS STRING
DIM Strasse AS STRING
DIM Postleitzahl AS STRING
DIM Wohnort AS STRING
DIM Bundesland AS STRING
DIM Land AS STRING
DIM Telefon_privat AS STRING
DIM Telefon_gesch AS STRING
DIM Telefon_Buero AS STRING
DIM Telefon_Funk AS STRING
DIM Telefon_mobil AS STRING
DIM Faxnummer AS STRING
DIM Emailadresse AS STRING
DIM Homepage AS STRING
DIM Titel AS STRING
DIM Position AS STRING
DIM Kuerzel AS STRING
DIM Anrede AS STRING
DIM Grussformel AS STRING
DIM Kontakt_ID AS STRING
DIM Kalender AS STRING
DIM Einladen AS STRING
DIM Notiz AS STRING
DIM Benutzer1 AS STRING
DIM Benutzer2 AS STRING
DIM Benutzer3 AS STRING
DIM Benutzer4 AS STRING

' Hilfsvariablen
DIM I AS INTEGER
DIM L AS LONG
DIM C, S AS STRING

ON ERROR GOTO Fehlerbehandlung

' Datenbankkontext erzeugen
DatabaseContext = createUnoService("com.sun.star.sdb.DatabaseContext")

' DataSource = Datenquelle für OOo-Adressbuch
DataSource = DatabaseContext.getByName(OOoAdressen)

' bei Bedarf Dialog für Passwortschutz aufrufen
IF NOT DataSource.IsPasswordRequired THEN
  Connection = DataSource.GetConnection("","")' ("Benutzername","Passwort")
ELSE
  InteractionHandler = createUnoService("com.sun.star.sdb.InteractionHandler")
  Connection = DataSource.ConnectWithCompletion(InteractionHandler)
END IF

' Statement: SQL-Kommunikationskanal für das OOo-Adressbuch
Statement = Connection.createStatement()

' Alle Adressen von Windows-Kontakte abfragen
Dateiname = Dir$(Suchpfad & "*.contact")

' Prüfen, ob in "Suchpfad" Kontaktdateien enthalten sind
IF Dateiname ="" THEN
  MsgBox "Der angegebene Suchpfad enthält keine Windows-Kontakte!", 16 ,"Fehler aufgetreten"
  GOTO Ende
END IF

' Alle Adressen von Windows-Kontakte auswerten, dazu für jede Adresse:
WHILE Dateiname <>""

  Dateitext = ""

  ' Nächste Kontaktdatei in "Dateitext" laden
  Dateinummer = FREEFILE
  OPEN Suchpfad & Dateiname FOR INPUT AS #Dateinummer
    WHILE NOT EOF(Dateinummer)
     LINE INPUT #Dateinummer,Dateizeile
     IF Dateizeile <> "" THEN
       Dateitext = Dateitext + Dateizeile + CHR$(13)
     END IF
    WEND
  CLOSE #Dateinummer

  ' Umlaute, Sonderzeichen und HTML-Codes in "Dateitext" bereinigen,
  ' wegen SQL-Strings einfache Anführungszeichen (') in doppelte (") wandeln
  S = ""
  L = 1
  DO WHILE L < LEN(Dateitext)
    C = MID$(Dateitext,L,1)
    IF C = "'" THEN C = CHR(34)
    IF C = "Ã" THEN ' 
      C = MID$(Dateitext,L,2)
      L = L + 1
      IF C = "Ä" THEN C = "Ä"
      IF C = "Ö" THEN C = "Ö"
      IF C = "Ãœ" THEN C = "Ü"
      IF C = "ä" THEN C = "ä"
      IF C = "ö" THEN C = "ö"
      IF C = "ü" THEN C = "ü"
      IF C = "ß" THEN C = "ß"
      IF C = "é" THEN C = "é"
      IF C = "è" THEN C = "è"
      IF C = "à" THEN C = "à"
    END IF
    IF C = "Â" THEN
      C = MID$(Dateitext,L,2)
      L = L + 1
      IF C = "§" THEN C = "§"
      IF C = "µ" THEN C = "µ"
    END IF
    IF C = "â" THEN
      C = MID$(Dateitext,L,3)
      L = L + 2
      IF C = "€" THEN C = "€" ' Euro
    END IF
    IF C = "&" THEN
      DO
        L = L + 1
        C = C + MID$(Dateitext,L,1)
      LOOP WHILE (L < LEN(Dateitext)) AND (MID$(Dateitext,L,1) <> ";")
      C = LCASE(C)
      IF C = "&amp;" THEN C = "&"
      IF C = "&gt;" THEN C = ">"
      IF C = "&lt;" THEN C = "<"
    END IF
    S = S + C
    L = L + 1
  LOOP
  
  Dateitext = S

  ' Temporäre Datensatzvariablen löschen
  Vorname = ""
  Nachname = ""
  Anzeigename = ""
  Firma = ""
  Abteilung = ""
  Strasse = ""
  Postleitzahl = ""
  Wohnort = ""
  Bundesland = ""
  Land = ""
  Telefon_privat = ""
  Telefon_gesch = ""
  Telefon_Buero = ""
  Telefon_Funk = ""
  Telefon_mobil = ""
  Faxnummer = ""
  Emailadresse = ""
  Homepage = ""
  Titel = ""
  Position = ""
  Kuerzel = ""
  Anrede = ""
  Grussformel = ""
  Kontakt_ID = ""
  Kalender = ""
  Einladen = ""
  Notiz = ""
  Benutzer1 = ""
  Benutzer2 = ""
  Benutzer3 = ""
  Benutzer4 = ""

  ' XML-basierte Kontaktdatei auswerten: Anmerkung, Notiz
  Taganfang = INSTR(1,Dateitext,"<C:Notes")
  IF Taganfang <> 0 THEN
    Zeilenanfang = INSTR(Taganfang,Dateitext,">") + 1
    Zeilenende = INSTR(Taganfang,Dateitext,"</C:Notes")
    Notiz = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
  END IF

  ' XML-basierte Kontaktdatei auswerten: Standard-Email-Adresse
  Collectionanfang = INSTR(1,Dateitext,"<C:EmailAddressCollection")
  IF Collectionanfang <> 0 THEN
    Collectionende = INSTR(Collectionanfang,Dateitext,"</C:EmailAddressCollection")
    DO
      Taganfang = INSTR(Collectionanfang + 1,Dateitext,"<C:EmailAddress")
      IF (Taganfang = 0) OR (Taganfang > Collectionende) THEN EXIT DO
      Tagende = INSTR(Taganfang,Dateitext,"</C:EmailAddress")
      Kontaktwert(1) = ""
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Address")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Address")
        Kontaktwert(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Kontaktlabel(1) = ""
      Labelanfang = INSTR(Taganfang,Dateitext,"<C:LabelCollection")
      IF (Labelanfang <> 0) AND (Labelanfang < Tagende) THEN
        Labelende = INSTR(Taganfang,Dateitext,"</C:LabelCollection")
        Labelanfang = INSTR(Labelanfang + 1,Dateitext,"<C:Label")
        IF (Labelanfang <> 0) AND (Labelanfang < Labelende) THEN
          Zeilenanfang = INSTR(Labelanfang,Dateitext,">") + 1
          Zeilenende = INSTR(Labelanfang,Dateitext,"</C:Label")
          Kontaktlabel(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
        END IF
      END IF
      IF Kontaktlabel(1) = "Preferred" THEN Emailadresse = Kontaktwert(1)
      Collectionanfang = Tagende
    LOOP
  END IF

  ' XML-basierte Kontaktdatei auswerten: Titel, Vorname, Nachname, Anzeigename
  Collectionanfang = INSTR(1,Dateitext,"<C:NameCollection")
  IF Collectionanfang <> 0 THEN
    Taganfang = INSTR(Collectionanfang + 1,Dateitext,"<C:Name")
    IF Taganfang <> 0 THEN
      Tagende = INSTR(Taganfang,Dateitext,"</C:Name",1)
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Nickname")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Nickname")
      ' Kuerzel = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Title")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Title")
        Titel = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:FormattedName")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:FormattedName")
        Anzeigename = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:FamilyName")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:FamilyName")
        Nachname = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:GivenName")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:GivenName")
        Vorname = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:MiddleName")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:MiddleName")
        Vorname = Vorname + MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
    END IF
  END IF

  ' XML-basierte Kontaktdatei auswerten: Land, Bundesland, PLZ, Ort, Strasse
  Collectionanfang = INSTR(1,Dateitext,"<C:PhysicalAddressCollection")
  IF Collectionanfang <> 0 THEN
    Collectionende = INSTR(Collectionanfang,Dateitext,"</C:PhysicalAddressCollection")
    DO
      Taganfang = INSTR(Collectionanfang + 1,Dateitext,"<C:PhysicalAddress")
      IF (Taganfang = 0) OR (Taganfang > Collectionende) THEN EXIT DO
      Tagende = INSTR(Taganfang,Dateitext,"</C:PhysicalAddress")
      Kontaktwert(1) = ""
      Kontaktwert(2) = ""
      Kontaktwert(3) = ""
      Kontaktwert(4) = ""
      Kontaktwert(5) = ""
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Country")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Country")
        Kontaktwert(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:PostalCode")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:PostalCode")
        Kontaktwert(2) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Region")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Region")
        Kontaktwert(3) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Locality")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Locality")
        Kontaktwert(4) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Street")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Street")
        Kontaktwert(5) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Kontaktlabel(1) = ""
      Labelanfang = INSTR(Taganfang,Dateitext,"<C:LabelCollection")
      IF (Labelanfang <> 0) AND (Labelanfang < Tagende) THEN
        Labelende = INSTR(Taganfang,Dateitext,"</C:LabelCollection")
        Labelanfang = INSTR(Labelanfang + 1,Dateitext,"<C:Label")
        IF (Labelanfang <> 0) AND (Labelanfang < Labelende) THEN
          Zeilenanfang = INSTR(Labelanfang,Dateitext,">") + 1
          Zeilenende = INSTR(Labelanfang,Dateitext,"</C:Label")
          Kontaktlabel(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
        END IF
      END IF
      IF Kontaktlabel(1) = "Business" THEN ' geschäftliche Adresse
    ' IF Kontaktlabel(1) = "Personal" THEN ' private Adresse
        Land = Kontaktwert(1)
        Postleitzahl = Kontaktwert(2)
        Bundesland = Kontaktwert(3)
        Wohnort = Kontaktwert(4)
        Strasse = Kontaktwert(5)
      END IF
      Collectionanfang = Tagende
    LOOP
  END IF

  ' XML-basierte Kontaktdatei auswerten: Telefon-, Fax-, Handynummer
  ' Nummern
  Collectionanfang = INSTR(1,Dateitext,"<C:PhoneNumberCollection")
  IF Collectionanfang <> 0 THEN
    Collectionende = INSTR(Collectionanfang,Dateitext,"</C:PhoneNumberCollection")
    DO
      Taganfang = INSTR(Collectionanfang + 1,Dateitext,"<C:PhoneNumber")
      IF (Taganfang = 0) OR (Taganfang > Collectionende) THEN EXIT DO
      Tagende = INSTR(Taganfang,Dateitext,"</C:PhoneNumber")
      Kontaktwert(1) = ""
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Number")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Number")
        Kontaktwert(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Kontaktlabel(1) = ""
      Kontaktlabel(2) = ""
      Labelanfang = INSTR(Taganfang,Dateitext,"<C:LabelCollection")
      IF (Labelanfang <> 0) AND (Labelanfang < Tagende) THEN
        Labelende = INSTR(Taganfang,Dateitext,"</C:LabelCollection")
        Labelanfang = INSTR(Labelanfang + 1,Dateitext,"<C:Label")
        IF (Labelanfang <> 0) AND (Labelanfang < Labelende) THEN
          Zeilenanfang = INSTR(Labelanfang,Dateitext,">") + 1
          Zeilenende = INSTR(Labelanfang,Dateitext,"</C:Label")
          Kontaktlabel(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
        END IF
        Labelanfang = Zeilenende
        Labelanfang = INSTR(Labelanfang + 1,Dateitext,"<C:Label")
        IF (Labelanfang <> 0) AND (Labelanfang < Labelende) THEN
          Zeilenanfang = INSTR(Labelanfang,Dateitext,">") + 1
          Zeilenende = INSTR(Labelanfang,Dateitext,"</C:Label")
          Kontaktlabel(2) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
        END IF
      END IF
      IF Kontaktlabel(1) = "Pager" THEN Telefon_Funk = Kontaktwert(1)
      IF (Kontaktlabel(1) = "Fax") AND (Kontaktlabel(2) = "Business") THEN Faxnummer = Kontaktwert(1)
    ' IF (Kontaktlabel(1) = "Fax") AND (Kontaktlabel(2) = "Personal") THEN Faxnummer = Kontaktwert(1)
      IF (Kontaktlabel(1) = "Voice") AND (Kontaktlabel(2) = "Business") THEN Telefon_gesch = Kontaktwert(1)
      IF (Kontaktlabel(1) = "Voice") AND (Kontaktlabel(2) = "Personal") THEN Telefon_privat = Kontaktwert(1)
      IF Kontaktlabel(1) = "Cellular" THEN Telefon_mobil = Kontaktwert(1)
      Collectionanfang = Tagende
    LOOP
  END IF

  ' XML-basierte Kontaktdatei auswerten: URLs
  Collectionanfang = INSTR(1,Dateitext,"<C:UrlCollection")
  IF Collectionanfang <> 0 THEN
    Collectionende = INSTR(Collectionanfang,Dateitext,"</C:UrlCollection")
    DO
      Taganfang = INSTR(Collectionanfang + 1,Dateitext,"<C:Url")
      IF (Taganfang = 0) OR (Taganfang > Collectionende) THEN EXIT DO
      Tagende = INSTR(Taganfang,Dateitext,"</C:Url")
      Kontaktwert(1) = ""
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Value")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Value")
        Kontaktwert(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Kontaktlabel(1) = ""
      Labelanfang = INSTR(Taganfang,Dateitext,"<C:LabelCollection")
      IF (Labelanfang <> 0) AND (Labelanfang < Tagende) THEN
        Labelende = INSTR(Taganfang,Dateitext,"</C:LabelCollection")
        Labelanfang = INSTR(Labelanfang + 1,Dateitext,"<C:Label")
        IF (Labelanfang <> 0) AND (Labelanfang < Labelende) THEN
          Zeilenanfang = INSTR(Labelanfang,Dateitext,">") + 1
          Zeilenende = INSTR(Labelanfang,Dateitext,"</C:Label")
          Kontaktlabel(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
        END IF
      END IF
      IF Kontaktlabel(1) = "Business" THEN Homepage = Kontaktwert(1) ' geschäftliche Webseite
    ' IF Kontaktlabel(1) = "Personal" THEN Homepage = Kontaktwert(1) ' private Webseite
      Collectionanfang = Tagende
    LOOP
  END IF

  ' XML-basierte Kontaktdatei auswerten: Büro, Abteilung, Position, Firma
  Collectionanfang = INSTR(1,Dateitext,"<C:PositionCollection")
  IF Collectionanfang <> 0 THEN
    Collectionende = INSTR(Collectionanfang,Dateitext,"</C:PositionCollection")
    DO
      Taganfang = INSTR(Collectionanfang + 1,Dateitext,"<C:Position")
      IF (Taganfang = 0) OR (Taganfang > Collectionende) THEN EXIT DO
      Tagende = INSTR(Taganfang,Dateitext,"</C:Position")
      Kontaktwert(1) = ""
      Kontaktwert(2) = ""
      Kontaktwert(3) = ""
      Kontaktwert(4) = ""
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Office")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Office")
        Kontaktwert(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Department")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Department")
        Kontaktwert(2) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:JobTitle")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:JobTitle")
        Kontaktwert(3) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Dateiposition = INSTR(Taganfang,Dateitext,"<C:Company")
      IF (Dateiposition <> 0) AND (Dateiposition < Tagende) THEN
        Zeilenanfang = INSTR(Dateiposition,Dateitext,">") + 1
        Zeilenende = INSTR(Taganfang,Dateitext,"</C:Company")
        Kontaktwert(4) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
      END IF
      Kontaktlabel(1) = ""
      Labelanfang = INSTR(Taganfang,Dateitext,"<C:LabelCollection")
      IF (Labelanfang <> 0) AND (Labelanfang < Tagende) THEN
        Labelende = INSTR(Taganfang,Dateitext,"</C:LabelCollection")
        Labelanfang = INSTR(Labelanfang + 1,Dateitext,"<C:Label")
        IF (Labelanfang <> 0) AND (Labelanfang < Labelende) THEN
          Zeilenanfang = INSTR(Labelanfang,Dateitext,">") + 1
          Zeilenende = INSTR(Labelanfang,Dateitext,"</C:Label")
          Kontaktlabel(1) = MID(Dateitext,Zeilenanfang,Zeilenende - Zeilenanfang)
        END IF
      END IF
      IF Kontaktlabel(1) = "Business" THEN
      ' Buero = Kontaktwert(1)
        Abteilung = Kontaktwert(2)
        Position = Kontaktwert(3)
        Firma = Kontaktwert(4)
      END IF
      Collectionanfang = Tagende
    LOOP
  END IF

  ' ... prüfen, ob Anzeigename (Primärschlüssel) bereits existiert
  ' SQL-Befehl "SELECT Anzeigename FROM Tabellenname WHERE Anzeigename='aktueller Wert'" vorbereiten
  SQL_Befehl = "SELECT "+CHR(34)+"Anzeigename"+CHR(34)+" FROM "+CHR(34)+OOoTabelle+chr(34)
  SQL_Befehl = SQL_Befehl +" WHERE "+CHR(34)+"Anzeigename"+CHR(34)+" = '"+Anzeigename+"'"
  ' und ausführen
  ResultSet = Statement.executeQuery(SQL_Befehl)
    
  ' ... falls KEIN Datensatz vorhanden, ergibt ResultSet.next den Wert false, und es muss
  ' ein Datensatz mit Wert im Feld "Anzeigename" erzeugt werden.
  ' "Anzeigename" ist ein Primärschlüssel es sind keine doppelten Einträge erlaubt.
  ' ResultSet enthält entweder genau einen, oder gar keinen Datensatz.
  IF NOT IsNull(ResultSet) THEN
    IF NOT ResultSet.next THEN

      ' SQL-Befehl "INSERT INTO Tabellenname (Anzeigename) VALUES ('aktueller Wert')" vorbereiten
      SQL_Befehl = "INSERT INTO "+CHR(34)+OOoTabelle+CHR(34)+" ("+CHR(34)+"Anzeigename"+CHR(34)
      SQL_Befehl = SQL_Befehl +") VALUES ('"+Anzeigename+"')"
      ' und ausführen
      Statement.executeUpdate(SQL_Befehl)

    END IF
  END IF

  ' Datensatz mit Anzeigename aktualisieren
  ' SQL-Befehl "UPDATE Tabellenname SET Feld1=Wert1, Feld2=Wert2, ...
  '             WHERE Anzeigename='aktueller Wert'" vorbereiten
  SQL_Befehl = "UPDATE "+CHR(34)+OOoTabelle+CHR(34)+" SET "+CHR(34)+"Vorname"+CHR(34)+" = '"+Vorname+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Name"+CHR(34)+" = '"+Nachname+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Kürzel"+CHR(34)+" = '"+Kuerzel+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Email"+CHR(34)+" = '"+Emailadresse+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Telefon gesch."+CHR(34)+" = '"+Telefon_gesch+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Telefon priv."+CHR(34)+" = '"+Telefon_privat+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"FAX"+CHR(34)+" = '"+Faxnummer+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Telefon Funk"+CHR(34)+" = '"+Telefon_Funk+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Handy"+CHR(34)+" = '"+Telefon_mobil+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Straße"+CHR(34)+" = '"+Strasse+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Ort"+CHR(34)+" = '"+Wohnort+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Bund.land"+CHR(34)+" = '"+Bundesland+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"PLZ"+CHR(34)+" = '"+Postleitzahl+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Land"+CHR(34)+" = '"+Land+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Position"+CHR(34)+" = '"+Position+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Abteilung"+CHR(34)+" = '"+Abteilung+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Firma"+CHR(34)+" = '"+Firma+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"URL"+CHR(34)+" = '"+Homepage+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Titel"+CHR(34)+" = '"+Titel+"', "
  SQL_Befehl = SQL_Befehl+ CHR(34)+"Notiz"+CHR(34)+" = '"+Notiz+"'"
  SQL_Befehl = SQL_Befehl +" WHERE "+CHR(34)+"Anzeigename"+CHR(34)+" = '"+Anzeigename+"'"
  ' und ausführen
  Statement.executeUpdate(SQL_Befehl)
  Dateiname = DIR$
WEND

GOTO Ende

Fehlerbehandlung:
MsgBox "Fehler " & ERR & ": " & ERROR$ + CHR(13) + "In line : " + ERL + CHR(13) + NOW , 16 ,"Fehler aufgetreten"
Ende:

END SUB

Besondere Lizenzbedingungen für Programmcode

This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details.

Anwendungsbeispiele

Windows®-Kontakte → WindowsKontakteMakroBaseVorlagen/AdressBuch

Siehe auch


KategorieBase KategorieMakro


LizenzBedingungen | AnbieterKennzeichnung | DatenschutzErklärung | Stand: 2013-04-28