• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Import text file (kml … xml)

sanju

Member
Dear sir,
Imports text file but it only import only single point. Can it import all the points as shown in sheet2.
Thank you.
Code:
 Sub Import_Point()
Dim KmlFileLoc As String, text As String, textline As String
KmlFileLoc = Application.GetOpenFilename()
'Won't read a KML, so you gotta make it a text fileKmlTxtCopy = KmlFileLoc & ".txt"
FileCopy KmlFileLoc, KmlTxtCopy
Open KmlTxtCopy For Input As #1
'EOF stands for End of FileDo Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
posName = InStr(text, "<name> ")
posEndName = InStr(text, " </name>")
PName = Mid(text, posName + 6, posEndName - posName - 6)
posCoords = InStr(text, "coordinates") + 12
posEndCoords = InStr(text, "</coordinates")
CoordVals = Mid(text, posCoords, posEndCoords - posCoords)
Dim pwb As Worksheet
Set pwb = ActiveSheet
Dim l As Integer
l = 1
Do While InStr(CoordVals, ",") > 1
CommaPos = InStr(CoordVals, ",")
Longitude = Left(CoordVals, CommaPos - 1)
pwb.Cells(l + 2, 2).Value = Longitude
'Trim out that Longitude excluding the commaCoordVals = Right(CoordVals, Len(CoordVals) - CommaPos)
'Do the Same for Latitude but in 2nd ColumnCommaPos = InStr(CoordVals, ",")
Latitude = Left(CoordVals, CommaPos - 1)
pwb.Cells(l + 2, 1).Value = Latitude
CoordVals = Right(CoordVals, Len(CoordVals) - CommaPos - 1)
pwb.Cells(2, 1).Value = "Latitude"
pwb.Cells(2, 2).Value = "Longitude"
pwb.Cells(2, 3).Value = "Name"
pwb.Cells(l + 2, 3).Value = PName
l = l + 1
Loop
End Sub
 

Attachments

  • Required File.xlsm
    38.1 KB · Views: 13
  • Point.txt
    98.3 KB · Views: 11
Sir,
There is no problem with your code, your code creates a new XML file, so we do not want a new file. We have decided to do this indirect import data.

Thank You
 
If you insist of importing it line by line, try this

Code:
Sub Import_Kml_File()

'Get the KML File
Dim KmlFileLoc As Variant
KmlFileLoc = Application.GetOpenFilename()

Dim sWhole As String
Dim v As Variant

Open KmlFileLoc For Input As #1
    sWhole = Input$(LOF(1), 1)
Close #1

'Shift the string to a Variant array
v = Split(sWhole, vbNewLine)
Dim rw as Integer, i as integer
rw = 2

'Loop through the array looking for </coordinates>
For i = 1 To UBound(v, 1) - 1
    If v(i) = "</coordinates>" Then
        'Debug.Print i, v(i - 1)
        Range(Cells(rw, 2), Cells(rw, 4)) = Split(v(i - 1), ",")
        On Error GoTo 20
        Cells(rw, 1) = Mid(v(i + 4), 8, Len(v(i + 4)) - 16)
10      GoTo 30

20      Cells(rw, 1) = v(i + 4)

30        rw = rw + 1
    End If
Next i
       
End Sub
 
My code created a Worksheet
You may need to click Save As to save it as a Worksheet
 
However the code is easily modified to import that file as well

Code:
Sub Import_Kml_File2()

'Get the KML File
Dim KmlFileLoc As Variant
KmlFileLoc = Application.GetOpenFilename()

Dim sWhole As String
Dim v As Variant
Dim rw As Integer

Open KmlFileLoc For Input As #1
    sWhole = Input$(LOF(1), 1)
Close #1

'Shift the string to a Variant array
v = Split(sWhole, vbNewLine)
rw = 2

'Loop through the array looking for </coordinates>
For i = 1 To UBound(v, 1) - 1
    If Left(v(i), 1) <> "<" Then
        Debug.Print i, v(i)
        Range(Cells(rw, 1), Cells(rw, 3)) = Split(v(i), ",")
        rw = rw + 1
    End If
Next i
       
End Sub

This coul also have been imported as a CSV file using a Comma delimitered format and then delete the heading and trailing rows
 
KML files can consist of multiple different data types including points, lines and many other data types

You now have a solution for points and lines, but not multiple lines

You can use the code I have supplied as the basis of extending them to multiple lines if required
 
Hello sir,
What sometimes happens is that our clients give us a kml file, and we have to draw a drawing through that kml file, client gives files only in two ways. One is point and second is line, But the common part is every kml file has a "</coordinates>" line.
One thing I have noticed is that many types of kml files have been made, so the codes of the kml are not matched each time.
As I've seen, your post no.4 the code is loop after every 20 lines, But in reality this will not be possible, but every kml File has a "<coordinates>" 0,0,0 "</coordinates>" line.

Thank you,
 
Hi !
Can it import all the points as shown in sheet2.
Yes, as any beginner can achieve just using Macro recorder !​
Code:
Sub Demo1()
    Application.ScreenUpdating = False
With Sheet1
        .UsedRange.Clear
        .Parent.XmlImport .Parent.Path & "\Point.kml", Nothing, True, .Cells(1)
        .ListObjects(1).Unlist
   With .UsedRange
        .Range("A:B,D:I,K:K").Delete
        .Columns(2).TextToColumns Comma:=True, DecimalSeparator:=".", TrailingMinusNumbers:=False
        .Rows(1).Clear
        .Columns(2).NumberFormat = "General"
        .Columns(2).AutoFit
   End With
        .[A1:D1].Value = [{"ID","Long","Lat","RL"}]
        Application.Goto .Cells(1), True
End With
    ThisWorkbook.XmlMaps("kml_Mappage").Delete
    Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
As my Macro Recorder xml demonstration imports Point.kml file from​
workbook's directory, just mod code accordingly ! Or move any file …​
 
' using old inStr function to find the value ..by finding the format <LookFor>value</Lookfor

>>> use code - tags <<<
Code:
Sub GetCoordsKML(KMLPa$, RaAdd$)

   Dim FilNum&: FilNum = FreeFile()
   Dim GSA$(), GSL$(), GS$, UB&
   Dim ValStart&, ValEnd&
   Dim LookFor$:  LookFor = "Coordinates"
   Dim Seps$: Seps = " "

   Dim Ri&, OutRa As Range: Set OutRa = ActiveSheet.Range(RaAdd$)
   OutRa.CurrentRegion.ClearContents


   Open KMLPa For Input As #FilNum
   GS = Input$(LOF(FilNum), FilNum)
   Close #FilNum
   
   ' find the value
 
   ValStart = InStr(GS, "<" & LookFor)
  
   ValStart = InStr(ValStart, GS, "<") + 8  ' 1 or what ever extra char in there
  
   '  <Lookfor  >  Plus the 8 char  >"0,0,0"   that are indicating >"lng,lat,Ht"   Maybe
  
   ValEnd = InStr(ValStart, GS, "</")
   GSA = Split(Mid(GS, ValStart, ValEnd - ValStart - 1), Seps)
  
   UB = UBound(GSA)
  'Set OutRa = ActiveSheet.Range(RaAdd$).Resize(UB + 1, 1)
  ' OutRa = GSA
 
  For Ri = 0 To UB - 1 ' extra " " at end point

  OutRa(Ri + 1, 1) = GSA(Ri)
  GSL = Split(GSA(Ri), ",")
OutRa(Ri + 1, 3) = Left(GSL(0), 16)

  OutRa(Ri + 1, 4) = Left(GSL(1), 16)
   Next Ri
  
End Sub
 
Last edited by a moderator:
Back
Top