VBA: Export Column to KML Format - Special Characters

[lummers]

Hello

I have an Excel file which allows a user to enter some data about an address and for a sheet in the Excel to build out a full KML file.

Here's what I'd like to achieve:
User to select the button, the VBA to export everything in a specific column on the worksheet (Final KML) as a KML file. User to be prompted where to save the file.

I have most of what I need with the below code.

However, I am getting stuck because the below code:
1. Removes all the special characters; my content is in Japanese and I need this to persist into the KML file
2. Trims the cells due breaching a max character length

I changed xlTextPrinter to be xlUnicodeText. However, UnicodeText adds is comma delimited and adding quotation marks and 'header' and 'footer' to the output.

Can someone please help me rejig so that:
(1) allows special characters, (2) does not trim the cells, (3) has no extra quotation marks, (4) has no header/footer tags in the output.

Thank you so much!

<code class="prettyprint prettyprinted" style="">Private Sub CommandButton1_Click()

    Application.DisplayAlerts = False

    Dim wb As Workbook, InitFileName As String, fileSaveName As String

    InitFileName = ThisWorkbook.Path & "\Export nr1_" & Format(Date, "yyyymmdd")

    Sheets("Final KML").Copy

    Set wb = ActiveWorkbook

    fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
    fileFilter:="KML Files (*.kml), *.kml")

    With wb
        If fileSaveName <> "False" Then

            .SaveAs fileSaveName, FileFormat:=xlTextPrinter, Local:=True
            .Close
        Else
            .Close False
            Exit Sub
        End If
    End With

End Sub</code>

 

[Norie]

Instead of using SaveAs why not write the output directly to the file using VBA file I/O methods?

I have this code that writes a KML file from a sheet called Data which has a name in column A, the latitude and longitude in columns B and C.

Sub GenerateKML()
Dim wsData As Worksheet
Dim rng As Range
Dim strName As String
Dim strLong As String
Dim strLat As String
Dim strPlace As String
Dim FF As Long

    Set wsData = Sheets("Data")
    
    Set filePath = "C:\Test\Data.kml"
        
    FF = FreeFile
    
    Open filePath For Output As FF
    
    'Write header to file
    
    Print #FF , "<?xml version=""1.0"" encoding=""UTF-8""?><kml xmlns=""http://www.opengis.net/kml/2.2""><Document>"
    
    Print #FF , "<name>Data List</name>"
    
    Set rng = wsData.Range("A2")
    
    Do
        strName = rng.Value
        strLong = rng.Offset(, 2).Value
        strLat = rng.offst(, 1).Value
    
        strPlace = "<Placemark>"
        strPlace = strPlace & "<name>" & strName & "</name>"
        strPlace = strPlace & "<Point>"
        strPlace = strPlace & "<coordinates>" & Join(Array(strLong, strLat, 0), ",") & "</coordinates>"
        strPlace = strPlace & "</Point>"
        strPlace = "</Placemark>"
        
        Print #FF , strPlace
        
        Set rng = rng.Offset(1)
    Loop Until rng.Value = ""
    
    Print #FF , "</Document></kml>"
    
    Close #FF 

End Sub

 

[lummers]

Norie - thank you! I really appreciate you helping with this. As a VBA beginner, I have that euphoric "it works!" feeling all thanks to your code.

I had to rejig it because what you provided was more complex than what I needed.

Here was my final code. I had line spaces in my output so added an end phrase to break the loop.

Private Sub CommandButton1_Click()
Dim wsData As Worksheet
Dim rng As Range
Dim strName As String
Dim FF As Long

    Set wsData = Sheets("Final KML")
    
    filePath = "C:\Test\data.kml"
        
    FF = FreeFile
    
    Open filePath For Output As FF
    
    'Write header to file
    
     
    Set rng = wsData.Range("B1")
    
    Do
        strName = rng.Value
                
        Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] , strName
        
        Set rng = rng.Offset(1)
    
    Loop Until rng.Value = "FINISH HIM!"
    
    Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] , ""
    
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] 
End Sub

 

[lummers]

As a final request, how could I tweak this to prompt the user where to save the file and what to call it - similar to the initial code I shared?

 

[lummers]

Sorry for triple-post..

Actually, the above code works fine *except* for the fact is is removing all my special characters and replacing them with ?s

 

[lummers]

OK. Making progress. The below is printing out the special characters!

However, the output file has an extra line return at the end of the file which can't seem to get rid of. Can anybody help me remove it?!

Private Sub Woof_Click()

Dim wsData As Worksheet
Dim rng As Range
Dim strName As String
Dim FF As Long

    
    strCRLF = StrConv(vbCrLf, vbUnicode)
    
    Set wsData = Sheets("Final KML")
    
    filePath = "C:\Test\data.kml"
        
    FF = FreeFile
    
    Open filePath For Output As FF
    
    
    
          
     
    Set rng = wsData.Range("B1")
      
        
    
    Do
        strName = StrConv((rng.Value), vbUnicode)
        
                
        Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] , strName
        
        Set rng = rng.Offset(1)
    
    Loop Until rng.Value = "FINISH HIM!"
        
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF]#FF[/URL] 

End Sub

 

[lummers]

Answering my own question. Phew, finally got there. All I needed to do was add a semi-colon to the end of the print command.

     Print [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF"]#FF[/URL] , strName;

Hopefully this helps someone else. Quick recap of what the code above does: there is a button and, when pressed, a KML file is generated. You could change the file path to save it as any file type, though. The bit which allowed the special characters to work was:

strName = StrConv((rng.Value), vbUnicode)

The code will loop through and print out anything until it finds the key word which was text in one of my cells.

 

[Norie]

Do you still need help with prompting the user for the filename and location to save?