• 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

New 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

sanju

New Member
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
 

Hui

Excel Ninja
Staff member
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
 

Hui

Excel Ninja
Staff member
My code created a Worksheet
You may need to click Save As to save it as a Worksheet
 

Hui

Excel Ninja
Staff member
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
 

Hui

Excel Ninja
Staff member
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
 

sanju

New Member
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,
 

Marc L

Excel Ninja
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 !
 

Marc L

Excel Ninja
As my Macro Recorder xml demonstration imports Point.kml file from​
workbook's directory, just mod code accordingly ! Or move any file …​
 
Top