In recent months, I’ve started recording tunnel passages, which required solving the problem of a lack of navigation satellite reception in those areas. GPS errors and problems also occur in locations where a lack of clear line of sight limits reception from multiple satellites to just a few.
The free tools of the OpenStreetMap editor JOSM have proven helpful in this regard. A small VBA script uploads an entire day’s recordings to this editor for analysis and editing. (Follow on Insta 360 Rename files Script: Better Insta360 X3 support - #43 by osmplus_org )
Sub B_OpenJOSM()
Dim josmPath As String
Dim ws As Worksheet
Dim gpxFolder As String
Dim fso As Object, file As Object
Dim gpxFiles As String
' === JOSM-Pfad ermitteln ===
josmPath = Environ("LOCALAPPDATA") & "\JOSM\JOSM.exe"
If Dir(josmPath) = "" Then
MsgBox "JOSM konnte nicht gefunden werden unter:" & vbCrLf & josmPath, vbExclamation
Exit Sub
End If
' === GPX-Verzeichnis aus GPX_Rename!P2 holen ===
Set ws = Worksheets("GPX_Rename")
ws.Activate
gpxFolder = ws.Range("P2").value
' === GPX-Dateien sammeln ===
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(gpxFolder) Then
MsgBox "GPX_JOSM-Verzeichnis existiert nicht:" & vbCrLf & gpxFolder, vbExclamation
Exit Sub
End If
gpxFiles = ""
For Each file In fso.GetFolder(gpxFolder).Files
If LCase(fso.GetExtensionName(file.Name)) = "gpx" Then
gpxFiles = gpxFiles & " """ & file.Path & """"
End If
Next file
If gpxFiles = "" Then
MsgBox "Keine GPX-Dateien im Verzeichnis gefunden:" & vbCrLf & gpxFolder, vbExclamation
Exit Sub
End If
' === JOSM mit GPX-Dateien starten ===
Shell """" & josmPath & """" & gpxFiles, vbNormalFocus
' === Aufräumen ===
Set fso = Nothing
Set file = Nothing
Set ws = Nothing
End Sub
Assuming a JOSM installation is present on the computer, this script imports GPX datasets as separate layers. Select OpenStreetMap Carto as the background layer and reduce the transparency to 50%. If an error is found in the GPX track being checked, convert it into a JOSM Way. This allows you to straighten outliers using JOSM tools. For example, I cut out erroneous sections caused by a lack of GPS signal in a tunnel and manually trace the tunnel route from OpenStreetMap. Tracks treated this way can then be exported back as GPX tracks using JOSM. Manually traced nodes require further processing because they lack timestamps. Perhaps Mapillary will be able to handle this task for us in the future.
Assuming you’re driving through a tunnel at a constant speed for a Mapillary recording, it’s sufficient to calculate a suitable, realistic time for manually added GPX nodes using the last available GPX time and the timestamp where time values become available again. This is a simple mathematical task. I’ve determined a suitable interval of approximately 25-35 meters for manually placed nodes (the length display of a newly drawn way in the lower left corner of the JOSM editor window is helpful here). The following Excel script currently handles this task for me. Perhaps Mapillary will integrate a similar function into its uploader. There are many conceivable scenarios where GPX recordings contain minor errors. Filling small time gaps with an averaged, simulated time would certainly be a significant improvement.
' Schritt 4 Makro importiert eine per JOSM bearbeitete GPX Datei, identifiziert Nodes denen eine Zeit Information fehlt, und füllt diese mit einer interpolierten Zeit auf. Anschließend wird die gefixte GPX Datei in ein Export Verzeichnis exportiert.
Sub D_BatchProcessFüller()
Dim fso As Object, folderPath As String, file As Object
Dim ws As Worksheet
Dim fileName As String, ext As String
Dim Pfad_und_Datei As String
' Verzeichnis auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "GPX-Verzeichnis auswählen"
If .Show <> -1 Then Exit Sub
folderPath = .SelectedItems(1)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
' Arbeitsblatt vorbereiten
Sheets("GPX_Import").Select
Set ws = Worksheets("GPX_Import")
' Durchlaufe alle GPX-Dateien im Verzeichnis
For Each file In fso.GetFolder(folderPath).Files
fileName = file.Name
ext = LCase(fso.GetExtensionName(fileName))
If ext = "gpx" And Left(fileName, 4) = "2025" Then
Pfad_und_Datei = file.Path
ws.Cells.Clear
' Dateiname und Pfad setzen
ws.Range("K5").value = fileName
ws.Range("K6").value = Pfad_und_Datei
' Importieren und verarbeiten
Call ImportAndFixGPX(Pfad_und_Datei)
' Exportieren
Call E_ExportGPX
End If
Next file
' Verbindung zum Dateisystem freigeben
Set fso = Nothing
Set file = Nothing
MsgBox "Alle GPX-Dateien wurden verarbeitet und exportiert.", vbInformation
End Sub
Sub ImportAndFixGPX(Pfad_und_Datei As String)
Dim xmlDoc As Object, trkpts As Object, boundsNode As Object
'Dim Pfad_und_Datei As Variant
Dim i As Long, j As Long
Dim ws As Worksheet
Dim prevTime As Date, nextTime As Date
Dim gapStart As Long, gapEnd As Long
Dim gapCount As Long, timeStep As Double
Dim currentTime As Date
Dim rawTime As String
Dim lastRow As Long
Dim ergänzteZeitpunkte As Long
ergänzteZeitpunkte = 0
' Arbeitsblatt aktivieren
Sheets("GPX_Import").Select
Set ws = Worksheets("GPX_Import")
ws.Cells.Clear
' === Schritt 1: GPX-Datei auswählen und laden ===
'Pfad_und_Datei = Application.GetOpenFilename(FileFilter:="GPX Files (*.gpx),*.gpx")
'If Pfad_und_Datei = False Then Exit Sub
' === Dateiname extrahieren und in Zelle K5 schreiben ===
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
ws.Range("K5").value = fso.GetFileName(Pfad_und_Datei) ' Nur Dateiname
ws.Range("K6").value = Pfad_und_Datei ' Vollständiger Pfad
Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
xmlDoc.async = False: xmlDoc.Load Pfad_und_Datei
If xmlDoc.ParseError.ErrorCode <> 0 Then
MsgBox "Fehler beim Laden der GPX-Datei: " & xmlDoc.ParseError.Reason, vbCritical
Exit Sub
End If
' Namespace setzen
xmlDoc.SetProperty "SelectionNamespaces", "xmlns:gpx='http://www.topografix.com/GPX/1/1'"
' === Schritt 2: Bounds extrahieren ===
Set boundsNode = xmlDoc.SelectSingleNode("//gpx:bounds")
If Not boundsNode Is Nothing Then
boundsText = "<bounds minlat=""" & boundsNode.getAttribute("minlat") & _
""" minlon=""" & boundsNode.getAttribute("minlon") & _
""" maxlon=""" & boundsNode.getAttribute("maxlon") & _
""" maxlat=""" & boundsNode.getAttribute("maxlat") & """ />"
ws.Range("K1").value = boundsText
Else
ws.Range("K1").value = "Keine Bounds gefunden"
End If
' === Schritt 3: Trackpunkte extrahieren ===
Set trkpts = xmlDoc.SelectNodes("//gpx:trkpt")
ws.Cells(1, 1).value = "Lat"
ws.Cells(1, 2).value = "Lon"
ws.Cells(1, 3).value = "Ele"
ws.Cells(1, 4).value = "Time"
Dim timeFound As Boolean
timeFound = False
For i = 0 To trkpts.Length - 1
ws.Cells(i + 2, 1).value = trkpts.Item(i).getAttribute("lat")
ws.Cells(i + 2, 2).value = trkpts.Item(i).getAttribute("lon")
If Not trkpts.Item(i).SelectSingleNode("gpx:ele") Is Nothing Then
ws.Cells(i + 2, 3).value = trkpts.Item(i).SelectSingleNode("gpx:ele").Text
End If
If Not trkpts.Item(i).SelectSingleNode("gpx:time") Is Nothing Then
ws.Cells(i + 2, 4).value = trkpts.Item(i).SelectSingleNode("gpx:time").Text
timeFound = True
End If
Next i
' === Prüfung: Zeitdaten vorhanden? ===
If Not timeFound Then
MsgBox "No time information found, import aborted." & vbCrLf & _
"Note: When editing GPX tracks with the JOSM editor, exporting the GPX time information only works if the GPX data is exported from the source layer.", vbCritical
Exit Sub
End If
' === Schritt 4: Zeitformat konvertieren ===
For i = 2 To ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
If ws.Cells(i, 4).value <> "" Then
rawTime = ws.Cells(i, 4).value
If Right(rawTime, 1) = "Z" Then rawTime = Left(rawTime, Len(rawTime) - 1)
rawTime = Replace(rawTime, "T", " ")
On Error Resume Next
ws.Cells(i, 6).value = CDate(rawTime)
ws.Cells(i, 6).NumberFormat = "yyyy-mm-dd hh:mm:ss"
On Error GoTo 0
End If
Next i
ws.Columns(6).AutoFit
'MsgBox "Zeitwerte konvertiert.", vbInformation
' === Schritt 5: Zeitlücken analysieren und interpolieren ===
lastRow = ws.Cells(ws.Rows.Count, 6).End(xlUp).Row
For i = 2 To lastRow
If IsDate(ws.Cells(i, 6).value) Then
currentTime = ws.Cells(i, 6).value
If prevTime <> 0 And currentTime < prevTime Then
currentTime = prevTime + TimeSerial(0, 0, 1)
End If
ws.Cells(i, 7).value = RoundTimeToSeconds(currentTime)
ws.Cells(i, 7).NumberFormat = "yyyy-mm-dd hh:mm:ss"
prevTime = ws.Cells(i, 7).value
Else
gapStart = i - 1
gapEnd = i
Do While gapEnd <= lastRow And Not IsDate(ws.Cells(gapEnd, 6).value)
gapEnd = gapEnd + 1
Loop
If gapEnd <= lastRow Then
prevTime = ws.Cells(gapStart, 7).value
nextTime = ws.Cells(gapEnd, 6).value
gapCount = gapEnd - gapStart - 1
timeStep = (nextTime - prevTime) / (gapCount + 1)
For j = gapStart + 1 To gapEnd - 1
currentTime = prevTime + timeStep * (j - gapStart)
ws.Cells(j, 7).value = RoundTimeToSeconds(currentTime)
ws.Cells(j, 7).NumberFormat = "yyyy-mm-dd hh:mm:ss"
ergänzteZeitpunkte = ergänzteZeitpunkte + 1
Next j
i = gapEnd - 1
prevTime = ws.Cells(i, 7).value
End If
End If
Next i
ws.Range("K4").value = ergänzteZeitpunkte
ws.Columns(7).AutoFit
'MsgBox "Spalte F analysiert und Spalte G mit Zielzeiten gefüllt.", vbInformation
' === Schritt 6: Eigene Bounds berechnen ===
Dim minLat As Double, maxLat As Double, minLon As Double, maxLon As Double
minLat = 90: maxLat = -90: minLon = 180: maxLon = -180
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If IsNumeric(ws.Cells(i, 1).value) And IsNumeric(ws.Cells(i, 2).value) Then
If ws.Cells(i, 1).value < minLat Then minLat = ws.Cells(i, 1).value
If ws.Cells(i, 1).value > maxLat Then maxLat = ws.Cells(i, 1).value
If ws.Cells(i, 2).value < minLon Then minLon = ws.Cells(i, 2).value
If ws.Cells(i, 2).value > maxLon Then maxLon = ws.Cells(i, 2).value
End If
Next i
Dim boundsCalculated As String
boundsCalculated = "<bounds minlat=""" & Format(minLat, "0.000000000000000") & _
""" minlon=""" & Format(minLon, "0.000000000000000") & _
""" maxlon=""" & Format(maxLon, "0.000000000000000") & _
""" maxlat=""" & Format(maxLat, "0.000000000000000") & """ />"
ws.Range("K2").value = boundsCalculated
'=== SchaltflächeFürGPXExportErzeugen===
'Dim btn As Button
' Vorherige Schaltfläche entfernen (optional)
'On Error Resume Next
'ws.Buttons("btnGPXExport").Delete
'On Error GoTo 0
' Neue Schaltfläche erstellen
'Set btn = ws.Buttons.Add(Cells(8, 11).Left, Cells(8, 11).Top, 150, 30) ' Zelle K8
'With btn
'.Name = "btnGPXExport"
'.Caption = "GPX-Datei exportieren"
'.OnAction = "ExportGPX"
'End With
' === Export starten ===
Call E_ExportGPX
End Sub
Sub E_ExportGPX()
Dim ws As Worksheet
Dim i As Long, lastRow As Long
Dim gpxText As String, trkptText As String
Dim boundsText As String, fileName As String
Dim exportFolder As String, outputPath As String
Dim TimeZoneOffset As Integer
Dim currentTime As String
Dim fso As Object
Dim originalPath As String, originalFolder As String, parentFolder As String
Dim exportBaseName As String
Dim folderItem As Object
Dim exportFound As Boolean
Set ws = Worksheets("GPX_Import")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' === Zeitstempel für Header ===
TimeZoneOffset = 2 ' UTC+2 für MESZ
currentTime = Format(Now - (TimeZoneOffset / 24), "yyyy-mm-dd\THH:NN:SS") & "Z"
' === Bounds aus Zelle K2 übernehmen und systemabhängig korrigieren ===
boundsText = Replace(ws.Range("K2").value, Application.International(xlDecimalSeparator), ".")
' === Dateiname aus Zelle K5 übernehmen ===
fileName = ws.Range("K5").value
If fileName = "" Then
MsgBox "Kein Dateiname in Zelle K5 gefunden.", vbCritical
Exit Sub
End If
' === Pfad zur GPX-Datei aus Zelle K6 übernehmen ===
originalPath = ws.Range("K6").value
Set fso = CreateObject("Scripting.FileSystemObject")
originalFolder = fso.GetParentFolderName(originalPath)
' === Übergeordnetes Verzeichnis ermitteln ===
On Error Resume Next
parentFolder = fso.GetParentFolderName(originalFolder)
On Error GoTo 0
If parentFolder = "" Or parentFolder = originalFolder Then
parentFolder = originalFolder
End If
' === Export#<Datum>-Verzeichnis suchen oder erzeugen ===
exportBaseName = "Export#" & Format(Date, "yyyymmdd")
exportFolder = parentFolder & "\" & exportBaseName
exportFound = False
For Each folderItem In fso.GetFolder(parentFolder).SubFolders
If folderItem.Name = exportBaseName Then
exportFolder = folderItem.Path
exportFound = True
Exit For
End If
Next folderItem
If Not exportFound Then
If Not fso.FolderExists(exportFolder) Then fso.CreateFolder exportFolder
End If
' === Exportpfad festlegen ===
outputPath = exportFolder & "\" & fileName
' === GPX-Header aufbauen ===
gpxText = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & _
"<gpx xmlns=""http://www.topografix.com/GPX/1/1"" creator=""Insta360 Studio"" version=""1.1"">" & vbCrLf & _
"<metadata>" & vbCrLf & _
"<link href=""https://www.insta360.com"">" & vbCrLf & _
"<text>Insta360 GPS Dashboard</text>" & vbCrLf & _
"</link>" & vbCrLf & _
"<time>" & currentTime & "</time>" & vbCrLf & _
boundsText & vbCrLf & _
"</metadata>" & vbCrLf & _
"<trk>" & vbCrLf & _
"<name>Insta360 GPS Data</name>" & vbCrLf & _
"<trkseg>" & vbCrLf
' === Trackpunkte erzeugen ===
For i = 2 To lastRow
If ws.Cells(i, 1).value <> "" And ws.Cells(i, 2).value <> "" Then
trkptText = "<trkpt lat=""" & FormatDecimalForGPX(ws.Cells(i, 1).value) & _
""" lon=""" & FormatDecimalForGPX(ws.Cells(i, 2).value) & """>" & vbCrLf
If ws.Cells(i, 3).value <> "" Then
trkptText = trkptText & "<ele>" & FormatDecimalForGPX(ws.Cells(i, 3).value) & "</ele>" & vbCrLf
End If
If IsDate(ws.Cells(i, 7).value) Then
trkptText = trkptText & "<time>" & Format(ws.Cells(i, 7).value, "yyyy-mm-dd\THH:NN:SS") & "Z</time>" & vbCrLf
End If
trkptText = trkptText & "</trkpt>" & vbCrLf
gpxText = gpxText & trkptText
End If
Next i
' === GPX-Ende anhängen ===
gpxText = gpxText & "</trkseg>" & vbCrLf & "</trk>" & vbCrLf & "</gpx>"
' === Datei schreiben ===
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Charset = "utf-8"
stream.Open
stream.WriteText gpxText
stream.SaveToFile outputPath, 2
stream.Close
'MsgBox "GPX-Datei erfolgreich exportiert:" & vbCrLf & outputPath, vbInformation
Sheets("Start").Select
End Sub
' === Funktion zum automatischen Anpassen des Trennzeichens ===
Function FormatDecimalForGPX(value As Variant) As String
Dim systemSeparator As String
systemSeparator = Application.International(xlDecimalSeparator)
FormatDecimalForGPX = Replace(Format(CDbl(value), "0.000000"), systemSeparator, ".")
End Function
' === Funktion zum Runden der Füllzeit ===
Function RoundTimeToSeconds(dt As Date) As Date
RoundTimeToSeconds = Int(dt * 86400 + 0.5) / 86400
End Function