KML Datei und POI-Datei im OV2-Format (TomTom) erstellen

[StefanP1962]

Hallo zusammen,

nachdem ich mal wieder hervorragende Unterstützung erhalten habe (Dank an Bernhard  ) möchte ich Euch doch teilhaben lassen an dem, was jetzt (wieder) funktioniert.

Problemstellung
Meine Notesanwendung enthält eine Menge Adressen, mit welchen ich meine Reiseplanung mache. Dazu benötige ich eine KML-Datei, um die Adressen mit Informationen in Google Earth anzeigen zu können. Weiterhin benötige ich für die Reiseplanung Reiseentfernungen und Reisezeiten. Gerne lasse ich mir auch die Adressen in Google Maps anzeigen, bzw. die Geodaten zurückliefern.

Codeschnipsel  
 Scritlibrary GeoData

Option Public
Option Declare
Use "Constants"


Sub GetGeoData(countrycode As String, postcode As String, city As String, street As String, latitude As String, longitude As String, latitudeDMS As String, longitudeDMS As String)
   
   ' #### -------------- Code example  -------------- ####
      'Get GeoData
      'street = doc.Con_Ges_Strasse(0)
      'city = doc.Con_Ges_Ort(0)
      'postcode = doc.Con_Ges_Plz(0)
      'countrycode = doc.Con_Ges_Lkz(0)
   
      'Call GetGeoData(countrycode, postcode, city, street, Latitude, Longitude)
   
      'If Latitude <> "" And Longitude <>"" Then
      '   Call uidoc.FieldSetText("Latitude", Latitude)
      '   Call uidoc.FieldSetText("Longitude", Longitude)
      'End If
   ' #### -------------- Code example  -------------- ####
   
   Dim ws As New NotesUIWorkspace
   Dim Page As Variant   
   Dim ReturnVar As Variant
   Dim keyFound As Long   
   Dim hlpInt As Integer   
   Dim hlpStr As String   
   Dim newType( 3 ) As String
   Dim outputStr As String    
   Dim q As String   
   Dim request As String      
   Dim ReturnStr As String      
   Dim rplType( 3 ) As String   
   Dim sensor As String   
   
   
   sensor ="sensor=false"
   outputStr = "xml"
   
   ' Types to replace
   rplType( 0 ) = "ä"
   rplType( 1 ) = "ö"
   rplType( 2 ) = "ü"
   rplType( 3 ) = "ß"
   
   ' new types for replace
   newType( 0 ) = "ae"
   newType( 1 ) = "oe"
   newType( 2 ) = "ue"
   newType( 3 ) = "ss"
   
   ' Replace types
   city = Replace( city, rplType, newType )
   street = Replace( street, rplType, newType )
   
   
   ' You may access the Google Geocoding API directly over HTTP by sending a request to
   '         V3 API: https://maps.googleapis.com/maps/api/geocode/output?parameters
   '                    https://maps.googleapis.com/maps/api/geocode/xml?address=Düsseldorfer Landstrasse 395,47259,Duisburg,DE&sensor=false
   
   ' output (required) — The format in which the output should be generated. The options are xml or (default) json. (For more information, see https://developers.google.com/maps/documentation/geocoding/#GeocodingRequests)
   ' address (required) — The address that you want to geocode.
   ' sensor (required) — Indicates whether or not the geocoding request comes from a device with a location sensor. This value must be either true or false. (Note that devices with sensors generally perform their own geocoding by definition; therefore, most geocoding requests to the Geocoding API should set sensor to false.)
   
   
   ' Request with the XMLHTTP object
   request = "https://maps.googleapis.com/maps/api/geocode/" + outputStr & "?address=" +  street + "," + postcode + "," + city + "," + countrycode +"&" + sensor
   Set page = CreateObject("Microsoft.XMLHTTP")
   'Set page = CreateObject("MSXML2.XMLHTTP")
   Call page.open("GET", request, False)
   Call page.send()
   
   Returnstr =page.responseText
   
   ' Split the result string
   ' ----------------------------------------------------
   ' needed:  
   ' - Geocoding-Statuscode
   ' - Accurancy (for help see: https://code.google.com/intl/en-En/apis/maps/documentation/javascript/v2/reference.html#GGeoAddressAccuracy)
   ' - Latitude
   ' - Longitude
   
   ReturnVar = Split(ReturnStr, Chr( 10 ))
   
   ' Request successfull?    --> xml-Line 3 = Status OK und xml Line 5 = street_address   
   If Instr( ReturnVar( 2 ), "<status>OK</status>" ) > 0 And Instr( returnVar( 4 ), ">street_address<" ) > 0 Then
      
      ReturnVar = Fulltrim( ReturnVar )
      
      ' Read xml file
      keyFound = Arraygetindex( ReturnVar, "<geometry>" )
      
      
      ' Found geometry, next entries = Location, Latitude, Longitude
      ' Latitude
      hlpStr = ReturnVar( keyFound +  2 )
      hlpInt = Instr( hlpStr, "</lat>" )            
      
      hlpStr = Left( hlpStr, hlpInt - 1 )               
      hlpInt = Instr( hlpStr, "<lat>" )
      hlpStr = Right( hlpStr, Len( hlpStr ) - hlpInt - Len( "<lat>" ) + 1 )
      
      latitude = hlpStr
      
      ' Longitude
      hlpStr = ReturnVar( keyFound +  3 )
      hlpInt = Instr( hlpStr, "</lng>" )            
      
      hlpStr = Left( hlpStr, hlpInt - 1 )               
      hlpInt = Instr( hlpStr, "<lng>" )
      hlpStr = Right( hlpStr, Len( hlpStr ) - hlpInt - Len( "<lng>" ) + 1 )
      
      longitude = hlpStr
      
      ' Convert to DMS
      Call Convert2DMS( latitude, longitude, latitudeDMS, longitudeDMS )
      
      
   Else
      'address not found
      Messagebox "The requested address could not be found at Google Geo Localisation!", MB_OK + MB_ICONSTOP, "Geo-Localisation"
      
      latitude = ""
      longitude = ""
      
   End If
   
   Set page = Nothing
End Sub

Sub Convert2DMS(latitude As String, longitude As String, latitudeDMS As String, longitudeDMS As String)
   
   Dim rest As Double
   Dim degree As String      
   Dim minutes As String
   Dim seconds As String
   
' Latitude
   
   ' Degree
   degree = Cstr( Fix( Val( Latitude ) ) )    
   rest = Val( Latitude ) - Val( degree )
   If Len( degree ) = 1 Then
      degree = "0" + degree
   End If
   
   ' Minutes
   rest = rest * 60
   minutes = Cstr( Fix( rest ) )   
   rest = rest - Val( minutes )
   If Len( minutes ) = 1 Then
      minutes = "0" + minutes
   End If
   
   ' Seconds   
   rest = Round( rest * 60, 0 )
   seconds = Cstr( rest )
   If Len( seconds ) = 1 Then
      seconds = "0" + seconds
   End If
   
   LatitudeDMS = degree + "°" + minutes + "'" + seconds + "''"
   
' Longitude
   ' Degree
   degree = Cstr( Fix( Val( Longitude ) ) )    
   rest = Val( Longitude ) - Val( degree )
   If Len( degree ) = 1 Then
      degree = "0" + degree
   End If
   
   ' Minutes
   rest = rest * 60
   minutes = Cstr( Fix( rest ) )   
   rest = rest - Val( minutes )
   If Len( minutes ) = 1 Then
      minutes = "0" + minutes
   End If
   
   ' Seconds   
   rest = Round( rest * 60, 0 )
   seconds = Cstr( rest )
   If Len( seconds ) = 1 Then
      seconds = "0" + seconds
   End If
   
   LongitudeDMS = degree + "°" + minutes + "'" + seconds + "''"
   
End Sub


In Google Maps anzeigen (Mal ganz simpel in Formelsprache )
Request := @If(Latitude = "";
   + Standort_Lkz + "," + Standort_Plz + "," +  Standort_Ort + "," + Standort_Strasse;
   Latitude + "," + Longitude);

"http://maps.google.com/maps?q=" + Request


Geodaten holen
Liefert Longitude und Latitude (auch im DMS Format) zurück.

Sub Click(Source As Button)
   
   Dim ws As New NotesUIWorkspace
   Dim uidoc As NotesUIDocument
   Dim doc As NotesDocument
   
   Dim Page As Variant   
   Dim ReturnVar As Variant
   
   Dim city As String   
   Dim countrycode As String   
   Dim key As String   
   Dim Latitude As String   
   Dim Longitude As String   
   Dim LatitudeDMS As String
   Dim LongitudeDMS As String
   Dim outputStr As String
   Dim postcode As String   
   Dim q As String   
   Dim request As String   
   Dim sensor As String   
   Dim street As String   
   
   
   Set uidoc = ws.CurrentDocument
   Set doc = uidoc.Document
   
   'Get GeoData
   street = doc.Standort_Strasse(0)
   city = doc.Standort_Ort(0)
   postcode = doc.Standort_Plz(0)
   countrycode = doc.Standort_Lkz(0)
   
   Call GetGeoData(countrycode, postcode, city, street, Latitude, Longitude, LatitudeDMS, LongitudeDMS )
   
   If Latitude <> "" And Longitude <>"" Then
      Call uidoc.FieldSetText("Latitude", Latitude)
      Call uidoc.FieldSetText("Longitude", Longitude)
      Call uidoc.FieldSetText("LatitudeDMS", LatitudeDMS)
      Call uidoc.FieldSetText("LongitudeDMS", LongitudeDMS)
      Call uidoc.Refresh
   End If
   
End Sub


 KML Datei erstellen
Hierbei werden individuelle Icon, welche im www liegen für die Placemarks verwendet, unterschiedliche "Ordner" der Placemarks, verschiedene Farben für die Rahmen
Dateipfade und Namen kommen aus dem Profil- und den Konfigurationsdokumenten.

Beispiel aus dem Profildokument (ProfDoc):
GE_FileName   TEXT   D:\...\meine Adressen.kml
GE_FolderName   TEXT   Meine Adressen
GE_Logo   TEXT   http://img18.myimg.de/Logoxxxxxx.jpg

Beispiel des Adressdokumentes (doc):
GE_Balloon_Color   TEXT   007b00
GE_Color      TEXT   green
GE_Folder      TEXT   ADV §11
GE_Icon      TEXT   http://img18.myimg.de/POIxxxxxx.jpg
GE_Icon_Size      TEXT   0,8


Sub Click(Source As Button)
   
   Dim ws As New NotesUIWorkspace   
   Dim session As New NotesSession
   Dim db As NotesDatabase   
   Dim view As NotesView   
   Dim uiview As NotesUIView   
   Dim doc As NotesDocument
   Dim ProfDoc As NotesDocument
   Dim iFolder As Integer   
   Dim iPlacemark As Integer   
   Dim fileNum As Integer   
   Dim outstring As String
   Dim Path As String
   Dim Filename As String
   Dim oldFolder As String
   Dim add_info As String
   Dim add_phone As String
   Dim iFolderStr As String
   Dim iPlacemarkStr As String
   
   
   Set db = session.CurrentDatabase
   Set uiview = ws.CurrentView
   Set view = uiview.View
   Set ProfDoc = db.GetProfileDocument( "Prof_Configuration" )
   
   ' Open file
   
   Path = ProfDoc.GE_FileName( 0 )
   If view.Name <> "Exportansicht" Then
      Path = Left(Path, Len( Path ) - 4 ) + "_" + view.Name + Right( Path, 4 )
   End If   
   fileNum% = Freefile()
   
   Open Path For Output As fileNum% Charset="UTF-8"
   
   '########  header information  ########
   outstring = "<?xml version=""1.0"" encoding=""UTF-8""?>"
   Print #fileNum%, outstring
   
   outstring = "<kml xmlns=""http://earth.google.com/kml/2.1"">"
   Print #fileNum%, outstring
   
   ' ## main folder
   outstring = "<Folder id=""layer fmain"">"
   Print #fileNum%, outstring
   
   outstring = "<name>" + ProfDoc.GE_FolderName( 0 ) + "</name>"
   Print #fileNum%, outstring
   
   '## other header information
   outstring = "<visibility>0</visibility>"
   Print #fileNum%, outstring   
   outstring = "<open>0</open>"
   Print #fileNum%, outstring
   
   
   '########  processing documents  ########
   Set doc = view.GetFirstDocument
   v
   While Not (doc Is Nothing)
      
      ' ## new folder?
      If oldFolder <> doc.GE_Folder( 0 ) Then
         
         ' #close folder
         If iFolder > 0 Then
            
            outstring = "</Folder>"
            Print #fileNum%, outstring      
            
         End If
         
         iFolder = iFolder +1    
         iFolderStr = Cstr( iFolder )
         
         outstring = "<Folder id=""layer" + iFolderStr + """>"
         Print #fileNum%, outstring      
         
         outstring= "<name>" + doc.GE_Folder( 0 ) + "</name>"
         Print #fileNum%, outstring
         
         outstring= "<visibility>0</visibility>"
         Print #fileNum%, outstring
         
         outstring= "<open>0</open>"
         Print #fileNum%, outstring
         
         ' ## remember folder name
         oldFolder = doc.GE_Folder( 0 )                  
         
      End If   
      
      ' ## count placemarks
      iPlacemark = iPlacemark +1    
      iPlacemarkStr = Cstr( iPlacemark )
      
      
      outstring= "<Placemark id=""layerP" + iPlacemarkStr + """>"
      Print #fileNum%, outstring
      
      outstring= "<Style id=""sn_" + iPlacemarkStr + """>"
      Print #fileNum%, outstring
      
      outstring= "<IconStyle>"
      Print #fileNum%, outstring
      
      outstring= "<scale>" + doc.GE_Icon_Size( 0 ) + "</scale>"                    'Icon size scale
      Print #fileNum%, outstring
      
      outstring= "<Icon><href>" + doc.GE_Icon( 0 ) + "</href></Icon>"
      Print #fileNum%, outstring
      
      outstring= "</IconStyle>"
      Print #fileNum%, outstring
      
      outstring= "<BalloonStyle id=""balloonstyle" + iPlacemarkStr + """>"   
      Print #fileNum%, outstring
      
      outstring= "<text><![CDATA["
      Print #fileNum%, outstring
      
      outstring= "<b><font color=" + doc.GE_Color( 0 ) + " size=6>$[name]</font></b><br><br>$[description]"     'Headline in balloon
      Print #fileNum%, outstring
      
      outstring= "]]></text>"
      Print #fileNum%, outstring
      
      outstring= "<bgColor>" + doc.GE_Balloon_Color( 0 ) + "</bgColor>"
      Print #fileNum%, outstring
      
      outstring= "</BalloonStyle>"
      Print #fileNum%, outstring
      
      outstring= "<LabelStyle><scale>1</scale></LabelStyle>"         'Font size scale placemark caption
      Print #fileNum%, outstring
      
      outstring= "<ListStyle>"
      Print #fileNum%, outstring
      
      outstring= "</ListStyle>"
      Print #fileNum%, outstring
      
      outstring= "</Style>"
      Print #fileNum%, outstring
      
      outstring= "<Style id=""sh_" + iPlacemarkStr + """>"
      Print #fileNum%, outstring
      
      outstring= "<IconStyle>"
      Print #fileNum%, outstring
      
      outstring= "<Icon><href>" + doc.GE_Icon( 0 ) + "</href></Icon>"
      Print #fileNum%, outstring
      
      outstring= "<scale>1</scale>"
      Print #fileNum%, outstring
      
      outstring= "</IconStyle>"
      Print #fileNum%, outstring
      
      outstring= "<BalloonStyle id=""balloonstyle" + iPlacemarkStr + """>"
      Print #fileNum%, outstring
      
      outstring= "<text><![CDATA["
      Print #fileNum%, outstring
      
      outstring= "<b><font color=" + doc.GE_Color( 0 ) +" size=6>$[name]</font></b><br><br>$[description]"
      Print #fileNum%, outstring
      
      outstring= "]]></text>"
      Print #fileNum%, outstring
      
      outstring= "<bgColor>" + doc.GE_Balloon_Color( 0 ) + "</bgColor>"
      Print #fileNum%, outstring
      
      outstring= "</BalloonStyle>"
      Print #fileNum%, outstring
      
      outstring= "<LabelStyle><scale>1</scale></LabelStyle>"
      Print #fileNum%, outstring
      
      outstring= "<ListStyle>"
      Print #fileNum%, outstring
      
      outstring= "</ListStyle>"
      Print #fileNum%, outstring
      
      outstring= "</Style>"
      Print #fileNum%, outstring
      
      outstring= "<StyleMap id=""myicon_" + iPlacemarkStr + """>"
      Print #fileNum%, outstring
      
      outstring= "<Pair>"
      Print #fileNum%, outstring
      
      outstring= "<key>normal</key>"
      Print #fileNum%, outstring
      
      outstring= "<styleUrl>#sn_" + iPlacemarkStr + "</styleUrl>"
      Print #fileNum%, outstring
      
      outstring= "</Pair>"
      Print #fileNum%, outstring
      
      outstring= "<Pair>"
      Print #fileNum%, outstring
      
      outstring= "<key>highlight</key>"
      Print #fileNum%, outstring
      
      outstring= "<styleUrl>#sh_" + iPlacemarkStr + "</styleUrl>"
      Print #fileNum%, outstring
      
      outstring= "</Pair>"
      Print #fileNum%, outstring
      
      outstring= "</StyleMap>"
      Print #fileNum%, outstring
      
      outstring= "<name>" + Replace( doc.Standortname( 0 ), "&", "+" ) +"</name>"
      Print #fileNum%, outstring
      
      outstring= "<visibility>1</visibility>"
      Print #fileNum%, outstring
      
      outstring= "<Snippet maxLines=""2"" id=""s" + iPlacemarkStr + """>"      'List caption
      Print #fileNum%, outstring
      
      If doc.Form( 0 ) = "Standort" Then
         outstring= doc.Standort_Ort( 0 ) + Chr(13) + Replace( doc.Gesellschaft( 0 ), "&", "+" )          
      Else
         outstring= Replace( doc.Firma( 0 ), "&", "+" )
      End If
      Print #fileNum%, outstring
      
      outstring= "</Snippet>"
      Print #fileNum%, outstring
      
      outstring= "<description>"
      Print #fileNum%, outstring
      
      outstring= "<![CDATA["
      Print #fileNum%, outstring
      
      ' # additional information?
      If doc.Informationen( 0 ) <>"" Then
         add_info = "<br> <br>Information: " + doc.Informationen( 0 )             
      Else
         add_info = ""
      End If
      
      If doc.Telefon( 0 ) <> "" Then
         add_phone = "<br>Phone: " + doc.Telefon( 0 )
      Else
         add_phone = ""
      End If
      
      Dim VName As New NotesName(doc.Standortverantwortlicher( 0 ))
      
      If doc.Form( 0 ) = "Standort" Then
         outstring= doc.Gesellschaft( 0 ) + " <br>" +_
         doc.Standort_Strasse( 0 ) + "<br>" + _
         doc.Standort_Plz( 0 ) + " " + doc.Standort_Ort( 0 ) + "<br> <br>" +_
         doc.Standorttyp( 0) + "<br> <br>Contact: " +_
         VName.Common + " - " + doc.Funktion( 0 ) +_
         add_phone + add_info         
      Else
         outstring= doc.Firma( 0 ) + " <br>" +_
         doc.Standort_Strasse( 0 ) + "<br>" + _
         doc.Standort_Plz( 0 ) + " " + doc.Standort_Ort( 0 ) + "<br> <br>" +_
         doc.Standorttyp( 0) + "<br> <br>Contact: " +_
         VName.Common + " - " + doc.Funktion( 0 ) +_
         add_phone + add_info
      End If
      Print #fileNum%, outstring
      
      outstring= " ]]>"
      Print #fileNum%, outstring
      
      outstring= "</description>"
      Print #fileNum%, outstring
      
      outstring= "<styleUrl>#myicon_" + iPlacemarkStr + "</styleUrl>"
      Print #fileNum%, outstring
      
      outstring= "<LookAt>"
      Print #fileNum%, outstring
      
      outstring= "<longitude>" + doc.Longitude( 0) + "</longitude>"
      Print #fileNum%, outstring
      
      outstring= "<latitude>" + doc.Latitude( 0 ) + "</latitude>"
      Print #fileNum%, outstring
      
      outstring= "<altitude>2000</altitude>"
      Print #fileNum%, outstring
      
      outstring= "<range>5000</range>"
      Print #fileNum%, outstring
      
      outstring= "<tilt>0</tilt>"
      Print #fileNum%, outstring
      
      outstring= "<heading>0</heading>"
      Print #fileNum%, outstring
      
      outstring= "<altitudeMode>relativeToGround</altitudeMode>"
      Print #fileNum%, outstring
      
      outstring= "</LookAt>"
      Print #fileNum%, outstring
      
      outstring= "<Point>"
      Print #fileNum%, outstring
      
      outstring= "<coordinates>"
      Print #fileNum%, outstring
      
      outstring= doc.Longitude(0) + "," + doc.Latitude( 0 ) +",2000"
      Print #fileNum%, outstring
      
      outstring= "</coordinates>"
      Print #fileNum%, outstring
      
      outstring= "</Point>"
      Print #fileNum%, outstring
      
      outstring= "</Placemark>"
      Print #fileNum%, outstring
      
      
      ' ### next document in view      
      Set doc = view.GetNextDocument( doc )
   Wend
   
   
   ' ### footer information
   outstring = "</Folder>"
   Print #fileNum%, outstring      
   
   outstring= "<ScreenOverlay id=""khScreenOverlay"">"
   Print #fileNum%, outstring
   
   outstring= "<name>Logo</name>"
   Print #fileNum%, outstring
   
   outstring= "<Icon>"
   Print #fileNum%, outstring
   
   outstring= "<href>" + profDoc.GE_Logo( 0 ) + "</href>"
   Print #fileNum%, outstring
   
   outstring= "</Icon>"
   Print #fileNum%, outstring
   
   outstring= "<overlayXY x=""0"" y=""1"" xunits=""fraction"" yunits=""fraction""/>"
   Print #fileNum%, outstring   
   
   outstring= "<screenXY x=""0"" y=""1"" xunits=""fraction"" yunits=""fraction""/>"
   Print #fileNum%, outstring
   
   outstring= "<size x=""-1"" y=""-1"" xunits=""pixels"" yunits=""pixels""/>"
   Print #fileNum%, outstring
   
   outstring= "</ScreenOverlay>"
   Print #fileNum%, outstring
   
   outstring= "</Folder>"
   Print #fileNum%, outstring
   
   outstring= "</kml>"
   Print #fileNum%, outstring
   
   
   ' close file
   Close fileNum%
   Messagebox "Die Datei '" + Path + "' wurde erstellt !",_
   MB_OK + MB_ICONEXCLAMATION
   
End Sub


 Exportieren nach OV2 (TomTom)
Benötigt wird das Programm OV2MAKER.exe, welches aus der Textdatei (.asc) eine OV2 DAtei macht. Hier können auch beliebige andere Programme für andere Navis verwendet werden.

Aus dem Profildokument (ProfDoc) kommt der Programmaufruf.
Beispiel: D:\POI\App\makeov2.exe @ "D:\Tabellendokumente\Geodaten\DS-Handbuch.asc" @ "D:\POI\DS-Handbuch.OV2"

Sub Click(Source As Button)
   
   Dim ws As New NotesUIWorkspace   
   Dim session As New NotesSession
   Dim db As NotesDatabase   
   Dim view As NotesView   
   Dim uiview As NotesUIView   
   Dim doc As NotesDocument
   Dim ProfDoc As NotesDocument
   Dim fileNum As Integer   
   Dim found As Integer
   Dim add_info As String
   Dim add_phone As String
   Dim convert As Variant      
   Dim convertPgm As String
   Dim convertSource As String
   Dim convertTarget As String
   Dim Filename As String   
   Dim newType( 3 ) As String   
   Dim outstring As String
   Dim Path As String
   Dim rplType( 3 ) As String   
   Dim shellStr As String
   
   Set db = session.CurrentDatabase
   Set uiview = ws.CurrentView
   Set view = uiview.View
   Set ProfDoc = db.GetProfileDocument( "Prof_Configuration" )
   
   ' Convert-Programm
   If ProfDoc.Convert( 0 ) <> "" Then
      If Instr( ProfDoc.Convert( 0 ), "@" ) Then
         convert = Split( ProfDoc.Convert( 0 ), "@" )
         convertPgm = convert( 0 )
         convertSource = convert( 1 )   
         convertTarget = convert( 2 )      
      Else
         convertPgm = Trim( convert( 0 ) )
      End If
      
      
   ' Types to replace
      rplType( 0 ) = Chr( 13 )
      rplType( 1 ) = Chr( 15 )
      rplType( 2 ) = Chr( 10 )
      
   ' new types for replace
      newType( 0 ) = ","
      newType( 1 ) = ","
      newType( 2 ) = ","
      
      
   ' Open file
      fileNum% = Freefile()
      Path = Replace( convertSource, """", "" )  
      
      Open Path For Output As fileNum% Charset = "Windows-1252"
      
   '########  processing documents  ########
      Set doc = view.GetFirstDocument
      
      While Not (doc Is Nothing)
         
         outstring = ""
         
         Dim VName As New NotesName(doc.Standortverantwortlicher( 0 ))
         
      ' Telefondaten
         If Len( doc.Telefon( 0 ) ) > 1Then
            add_phone = " >" + Right$( doc.Telefon( 0 ), Cint( Len(doc.Telefon( 0 ) ) - 1) )
            add_phone = Replace( add_phone, " ", "" )
         Else
            add_phone = ""
         End If
         
         If doc.Form( 0 ) = "Standort" Then
            outstring = doc.Longitude( 0 ) + "," +_
            doc.Latitude( 0 ) + "," +_
            """" + doc.Standortname( 0 ) + " [" + doc.Gesellschaft( 0 ) + " - " + doc.Standort_Strasse( 0 ) + ", " + doc.Standort_Plz( 0 ) + " " + doc.Standort_Ort( 0 ) + "]" + add_phone + """"
         Else         
            outstring = doc.Longitude( 0 ) + "," +_
            doc.Latitude( 0 ) + "," +_
            """" + doc.Firma( 0 ) + " [" + Replace( doc.Informationen( 0 ), rplType, newType ) + " - " + doc.Standort_Strasse( 0 ) + ", " +  doc.Standort_Plz( 0 ) + " " + doc.Standort_Ort( 0 ) + "]" + add_phone + """"
         End If
         
         Print #fileNum%, outstring
         
         ' ### next document in view      
         Set doc = view.GetNextDocument( doc )
         
      Wend
      
      
      ' close file
      Close fileNum%
      
      ' Converting file
      found = Instr( convertPgm, ":" )
      Chdrive ( Right( Left( convertPgm, found - 1), 1 ) )
      
      shellStr = convertPgm + " " + convertSource + " "+ convertTarget
      result = Shell   (shellStr, 1)
      
      
      Messagebox "Die Datei '" + convertTarget + "' wurde erstellt !", MB_OK + MB_ICONEXCLAMATION, "Hinweis"
   End If
   
End Sub

 
 Routendaten von Google Maps bekommen (auszugsweise)

Hier wird das Adressarray gefüllt:
                        Redim Preserve GoogleArr( i + iGA ) As String      
         Redim Preserve GoogleArr2( i + iGA ) As String      
         GoogleArr( i + iGA ) = ZwZielStrasse + "," + ZwZielOrt + "," + ZwZielLkz
         GoogleArr2( i + iGA ) = ZwZielStrasse + "," + ZwZielOrt + "," + ZwZielLkz

Und jetzt abgearbeitet:
       ' Zielort = Heimadresse
   Redim Preserve Googlearr( Ubound( GoogleArr ) +1 ) As String
   Redim Preserve Googlearr2( Ubound( GoogleArr2 ) +1 ) As String
   GoogleArr( Ubound( GoogleArr ) ) = Heimadresse
   GoogleArr2( Ubound( GoogleArr2 ) ) = "&sensor=false&units=metric&region=DE"
   
   ' Request String zusammensetzen
   ' http://maps.google.com/maps?saddr=Startadresse&daddr=ZwZiel1 +to:ZwZiel2, ....
   ' Request2 String zusammensetzen
   ' http://maps.googleapis.com/maps/api/directions/xml?origin=Startadresse&destination=Zieladresse&waypoints=ZwZiel1|ZwZiel2, ....
   
   For i = 0 To Ubound( GoogleArr )
      
      If i = 0 Then      'Startadresse
         Request = "http://www.google.de/maps?f=d&source=s_d&saddr="
         Request2 = "http://maps.googleapis.com/maps/api/directions/xml?origin=" + GoogleArr2( i ) + "&destination=" + GoogleArr2( i )
      End If
      
      If i = 1 Then      'Zieladresse für Browser bzw. Zwischenziel für XML
         Request = Request + "&daddr="
         Request2 = Request2 + "&waypoints="
      End If
      
      If i > 1 Then      ' weitere Ziele für Browser bzw. weitere Zwischenziele für XML
         Request = Request + "+to:"
         Request2 = Request2 + "|"
      End If
      
      Request = Request + GoogleArr( i )
      Request2 = Request2 + GoogleArr2( i )
      
   Next
   
   ' Zeichen, die zu ersetzen sind
   Redim Preserve rplType( 3 ) As String   
   Redim Preserve newType( 3 ) As String
   rplType( 0 ) = "ä"
   rplType( 1 ) = "ö"
   rplType( 2 ) = "ü"
   rplType( 3 ) = "ß"
   
   ' neue Zeichen
   newType( 0 ) = "ae"
   newType( 1 ) = "oe"
   newType( 2 ) = "ue"
   newType( 3 ) = "ss"
   
   ' Ersetzen der Zeichen
   Request = Replace( Request, rplType, newType )
   Request2 = Replace( Request2, rplType, newType )
   
   
   ' #### Aufruf GoogleMaps im Browser ####
   Call ws.URLOpen( Request )
   
' #### The Google Directions API   ####
' You may access the The Google Directions API directly over HTTP by sending a request to http://maps.googleapis.com/maps/api/directions/xml?
' You can also access the API over SSL, by substituting https in the request.
' origin (required) - Startaddress
' destination (required) - Endaddress   
' waypoints (optional) - Waypoints between Start- and Endpoint    
' sensor (required) — Indicates whether or not the geocoding request comes from a device with a location sensor. This value must be either true or false. (Note that devices with sensors generally perform their own geocoding by definition; therefore, most geocoding requests to the Geocoding API should set sensor to false.)
' region (optional) — The country code, specified as a ccTLD ("top-level domain") two-character value. (For more information see Country Code Biasing below.)
   
   
' Request with the XMLHTTP object
'++++++   request = "https://maps.googleapis.com/maps/api/directions/xml?origin=Bergerstrasse 119a, 42657 Solingen, DE&destination=Bergerstrasse 119a, 42657 Solingen,DE&waypoints=Geheimrat-Ebert-Strasse,Goslar,DE|Hannover,DE|Braunschweig,DE&sensor=false&units=metric&HL=DE"
   Set page = CreateObject("Microsoft.XMLHTTP")
   'Set page = CreateObject("MSXML2.XMLHTTP")
   Call page.open("GET", request2, False)
   Call page.send()
   
   Returnstr =page.responseText
   
' Split the result string
' ----------------------------------------------------
' - HTTP-Statuscode
' - Accurancy (for help see: https://code.google.com/intl/en-En/apis/maps/documentation/javascript/v2/reference.html#GGeoAddressAccuracy)
' - Latitude
' - Longitude
   
   'Dateiausgabe   
   ReturnStr = Replace( ReturnStr, "UTF-8", "Windows-1252")
   
   Dim fileNum As Integer
   fileName = Tempverzeichnis + "GoogleMapsRoute.xml"
   fileNum% = Freefile()
   Open fileName For Output As fileNum%
   Print #fileNum%, ReturnStr       
   
   Close fileNum%
   
   ' Request successfull?      
   ReturnVar = Split(ReturnStr, "<status>" )   
   If Left( ReturnVar(1), Instr( ReturnVar( 1 ), ">") ) = "OK</status>" Then
      ReturnVar = Split(ReturnStr, "<" )
      
      ' Datei lesen und ReturnVar füllen
      Redim ReturnVar( 0 ) As String       
      i = 0
      
      fileNum% = Freefile()
      Open fileName For Input As fileNum%
      
      Do Until Eof ( fileNum% )
         Line Input #fileNum% , iLine
         Redim Preserve ReturnVar( i ) As String
         ReturnVar( i ) = iLine
         i = i + 1
      Loop   
      
      Close fileNum%      
      
      
      ' ReturnVar abarbeiten
      For i = 0 To Ubound( ReturnVar )
         ' Suchen nach "start_address"
         strFound = Instr( ReturnVar( i ), "start_address" )
         
         'gefunden
         If strFound <> 0 Then            
            ' Jetzt immer 10 Zeilen zurück, da stehen die Kilometer
            ' <text>414 km</text>
            strFound = i - 10
            hlpStr = ReturnVar( strFound )
            hlpInt = Instr( hlpStr, " km</text>" )            
            
            ' bei gleicher Adresse kommt hlpInt = 0
            If hlpInt = 0 Then
               hlpStr = 0
            Else
               hlpstr = Left( hlpStr, hlpInt - 1 )               
               hlpInt = Instr( hlpStr, "<text>" )
               hlpStr = Right( hlpStr, Len( hlpStr ) - hlpInt - Len( "<text>" ) + 1 )
            End If
            
            ' Wert ins Array schreiben
            Redim Preserve kmArr( iKM ) As String
            kmArr( iKM ) = Cstr( Round( Val( hlpStr ), 1 ) )
            ' Werte unter 1 km aufrunden auf 1 km
            If kmArr( iKM ) < 1 And kmArr( iKM ) > 0 Then
               kmArr( iKM ) = 1
            Else
               kmArr( iKM ) = Round( kmArr( iKM ), 0 )
            End If
            iKM = iKM + 1
            
         ' Jetzt immer 14 Zeilen zurück, da steht die Dauer
         ' <text>33 mins</text>
            
            ' Zeichen, die zu ersetzen sind
            Redim Preserve rplDauer( 3 ) As String   
            Redim Preserve newDauer( 3 ) As String
            rplDauer( 0 ) = " hours "
            rplDauer( 1 ) = " hour "
            rplDauer( 2 ) = " mins"
            rplDauer( 3 ) = " min"
            
            ' neue Zeichen
            newDauer( 0 ) = " h  "
            newDauer( 1 ) = " h  "
            newDauer( 2 ) = " m"
            newDauer( 3 ) = " m"
            
            strFound = i - 14
            hlpStr = ReturnVar( strFound )
            hlpInt = Instr( hlpStr, "</text>" )            
            
         ' bei gleicher Adresse kommt hlpInt = 0
            If hlpInt = 0 Then
               hlpStr = 0
            Else
               hlpstr = Left( hlpStr, hlpInt - 1 )               
               hlpInt = Instr( hlpStr, "<text>" )
               hlpStr = Right( hlpStr, Len( hlpStr ) - hlpInt - Len( "<text>" ) + 1 )
               hlpStr = Replace( hlpStr, rplDauer, newDauer )               
            End If
            
         ' Wert ins Array schreiben
            Redim Preserve DauArr( iDau ) As String
            DauArr( iDau ) = hlpStr
            
            iDau = iDau + 1
            
         End If
         
      Next
      
   ' Werte aus dem Array in die Maske übertragen
      For i = 0 To Ubound( kmArr )
         If kmArr( i ) <> "" Then
            If i < Ubound( kmArr ) Then
               Call uidoc.FieldSetText( "Dienstreise_km_" + Cstr( i ), Cstr( kmArr( i ) ) )
               Call uidoc.FieldSetText( "Dauer_" + Cstr( i ), Cstr( DauArr( i ) ) )
            Else
               Call uidoc.FieldSetText( "km_Heimfahrt", Cstr( kmArr( i ) ) )   
               Call uidoc.FieldSetText( "Dauer_Heimfahrt", Cstr( DauArr( i ) ) )   
            End If
            
         End If         
      Next
      
      ' Alles berechnet --> ordentliche Anzeige
      Call uidoc.FieldSetText( "calculated", "1")
      
      Call uidoc.RefreshHideFormulas
      Call uidoc.Refresh
      
      
   Else
      ' Route nicht vollständig gefunden
      answer = Messagebox("Die Anfrage war nicht erfolgreich!" + Chr(13) + "Errorcode: " + Left( ReturnVar(1), Instr( ReturnVar( 1 ), "<") ) + Chr(13) + Chr(13) +_
      "Für mehr Informationen zum Fehler auf google.com Klicken Sie bitte 'Abbrechen.'" , 1 + 16, "Routenplanung")
      
      If answer = 2 Then
         Call ws.URLOpen("https://developers.google.com/maps/documentation/directions/#StatusCodes")
      End If
      
   End If
   
   Set page = Nothing


  Sodale, das war es. Ich hoffe, der ein oder andere kann es gebrauchen.

Beste Grüße

Stefan