Page 1 of 2 12 LastLast
Results 1 to 15 of 16
  1. #1
    Join Date
    Sep 2005
    Posts
    37

    Unanswered: VBA Question regarding Looping

    I have built a database in MS Access and created a module to export to a kml file. I'm a beginner in VBA, and I found the code on another forum from someone who found it on another forum and then modified it to fit his needs. I've been tweaking it to get it to do what I want it to, but I'm stumped on one thing. The Do Loop does it's job, but doesn't exactly do what I want it to do. While it processes all of the files and the module creates the kml file, it only creates the first folder in the first level and the first folder in the second level and puts all of the files into it, instead of creating individual folders in the first and second levels and putting the appropriate files within the their respective folders in the second level. Here is the code that I used. Any help would be greatly appreciated. Thanks in advance.

    ** Clarification **
    Here is how I want the output to look like:

    Folder 1
    Folder A
    Placemark A1
    Placemark A2
    Placemark A3
    Folder B
    Placemark B1
    Placemark B2
    Folder C
    Placemark C1

    Folder 2
    Folder A
    Folder B
    Folder C
    Folder 3
    Folder A
    Folder B
    Folder C

    Option Compare Database

    Private Sub Command33_Click()
    'DoCmd.OpenQuery "qryFacility"
    'Export data to text file

    Dim MyDB As Database
    Dim MYRS As Recordset
    Dim fld As Field
    Dim strText As String
    Dim MyTableName As String
    Dim QryOrTblDef As String
    Dim iFile As Integer
    QryOrTblDef = "qryFacility"
    Set MyDB = CurrentDb
    Set MYRS = MyDB.OpenRecordset(QryOrTblDef)
    iFile = FreeFile

    Open "C:\Test.kml" For Output Shared As #iFile

    Print #iFile, "<?xml version=""1.0"" encoding=""UTF-8""?>"
    Print #iFile, "<kml xmlns=""http://earth.google.com/kml/2.1"">"
    Print #iFile, "<Document>"
    Print #iFile, " <name>Test</name>"
    Print #iFile, " <Folder>"
    Print #iFile, " <name>" & MYRS.Fields(24) & "</name>"
    Print #iFile, " <open>1</open>"
    Print #iFile, " <Folder>"
    Print #iFile, " <name>" & MYRS.Fields(23) & "</name>"
    Print #iFile, " <open>1</open>"
    Print #iFile, " <Snippet maxLines=""0""></Snippet>"
    With MYRS
    Do Until .EOF
    Print #iFile, " <Placemark>"
    strText = " <name>" & MYRS.Fields(0) & "</name>"
    Print #iFile, strText
    Print #iFile, " <Snippet maxLines=""0""></Snippet>"
    strText = " <description></description>"
    Print #iFile, strText
    Print #iFile, " <LookAt>"
    Print #iFile, " <longitude>-" & MYRS.Fields(21) & "</longitude>"
    Print #iFile, " <latitude>" & MYRS.Fields(20) & "</latitude>"
    Print #iFile, " <altitude>0</altitude>"
    Print #iFile, " <heading>0</heading>"
    Print #iFile, " <tilt>0</tilt>"
    Print #iFile, " <range>1000</range>"
    Print #iFile, " <altitudeMode>relativeToGround</altitudeMode>"
    Print #iFile, " <gx:altitudeMode>relativeToSeaFloor</gx:altitudeMode>"
    Print #iFile, " </LookAt>"

    Print #iFile, " <Point>"
    Print #iFile, " <coordinates>" & MYRS.Fields(25) & "</coordinates>"
    Print #iFile, " </Point>"
    Print #iFile, " </Placemark>"
    .MoveNext
    Loop
    End With
    Print #iFile, " </Folder>"
    Print #iFile, " </Folder>"
    Print #iFile, "</Document>"
    Print #iFile, "</kml>"
    Close #iFile
    MYRS.Close
    Set MYRS = Nothing
    Set MyDB = Nothing
    'Shell "ENTERKMLFILENAMEHERE"

    End Sub
    Last edited by Bruce_S; 06-06-11 at 09:05. Reason: Additional Clarification

  2. #2
    Join Date
    Mar 2009
    Location
    Dorset
    Posts
    119
    Can you post the kml file.

    Also, can you post the exact folder ouput like you posted the required folder output.

    Thanks
    Regards
    JD

    Software-Matters

  3. #3
    Join Date
    Sep 2005
    Posts
    37

    Assist with VBA to create kml file

    JD,

    I recreated the DB and cleaned updated the coding, which is listed below. Also attached the kml file. After looking at my post, it looked confusing because some of what I typed wasn't there...the part about what I was trying to get and what I was getting. This DB lists travel destinations, both for work and personal vacations. The data is also categorized by state. What I'm trying to get is two folders in the root directory of the file, personal and work. Within each of those two folders would be folders for states, and within the states folders would be the placemarks. What I'm getting, as you can see, is just one folder in the root directory, one state folder (Florida) in that, and all of the placemarks within the Florida folder. I'm not very experienced with the coding, and I'm assuming the Do Loop command is not set up properly. Thanks in advance for your help.


    Private Sub Command33_Click()

    Dim MyDB As Database
    Dim MYRS As Recordset
    Dim fld As Field
    Dim strText As String
    Dim MyTableName As String
    Dim QryOrTblDef As String
    Dim iFile As Integer
    QryOrTblDef = "qryTravel"
    Set MyDB = CurrentDb
    Set MYRS = MyDB.OpenRecordset(QryOrTblDef)
    iFile = FreeFile

    Open "C:\TestDB.kml" For Output Shared As #iFile

    Print #iFile, "<?xml version=""1.0"" encoding=""UTF-8""?>"
    Print #iFile, "<kml xmlns=""http://earth.google.com/kml/2.1"">"
    Print #iFile, "<Document>"
    Print #iFile, " <name>TestDB</name>"
    Print #iFile, " <Folder>"
    Print #iFile, " <name>" & MYRS.Fields(8) & "</name>"
    Print #iFile, " <open>1</open>"
    Print #iFile, " <Folder>"
    Print #iFile, " <name>" & MYRS.Fields(9) & "</name>"
    Print #iFile, " <open>1</open>"
    Print #iFile, " <Snippet maxLines=""0""></Snippet>"
    With MYRS
    Do Until .EOF
    Print #iFile, " <Placemark>"
    strText = " <name>" & MYRS.Fields(2) & "</name>"
    Print #iFile, strText
    Print #iFile, " <Snippet maxLines=""0""></Snippet>"
    strText = " <description></description>"
    Print #iFile, strText

    Print #iFile, " <LookAt>"
    Print #iFile, " <longitude>-" & MYRS.Fields(5) & "</longitude>"
    Print #iFile, " <latitude>" & MYRS.Fields(4) & "</latitude>"
    Print #iFile, " <altitude>0</altitude>"
    Print #iFile, " <heading>0</heading>"
    Print #iFile, " <tilt>0</tilt>"
    Print #iFile, " <range>1000</range>"
    Print #iFile, " <altitudeMode>relativeToGround</altitudeMode>"
    Print #iFile, " <gx:altitudeMode>relativeToSeaFloor</gx:altitudeMode>"
    Print #iFile, " </LookAt>"

    Print #iFile, " <Point>"
    Print #iFile, " <coordinates>" & MYRS.Fields(6) & "</coordinates>"
    Print #iFile, " </Point>"
    Print #iFile, " </Placemark>"
    .MoveNext
    Loop
    End With
    Print #iFile, " </Folder>"
    Print #iFile, " </Folder>"
    Print #iFile, "</Document>"
    Print #iFile, "</kml>"
    Close #iFile
    MYRS.Close
    Set MYRS = Nothing
    Set MyDB = Nothing
    'Shell "ENTERKMLFILENAMEHERE"

    End Sub
    Attached Files Attached Files

  4. #4
    Join Date
    Mar 2009
    Location
    Dorset
    Posts
    119
    Sorry but the test.zip file won't open - it says it's invalid or corrupt?
    Regards
    JD

    Software-Matters

  5. #5
    Join Date
    Sep 2005
    Posts
    37
    JD,

    I have attached the kml file and changed the extension to txt. Try changing it back to kml and see if it opens.

    Thanks.
    Bruce
    Attached Files Attached Files

  6. #6
    Join Date
    Mar 2009
    Location
    Dorset
    Posts
    119
    Hi, Sorry but can you post the data that you are trying to output to the kml file. Either as a database or a spreqadsheet or something because I think this will help me solve your problem.
    Thanks.
    Regards
    JD

    Software-Matters

  7. #7
    Join Date
    Sep 2005
    Posts
    37
    JD,

    Thanks in advance for taking a look at this. I have two attachments... a zip file of the database, and the database itself, which I renamed to a txt file and needs to be renamed with an .accdb extension, just in case you can't open the zip file again.

    Bruce
    Attached Files Attached Files

  8. #8
    Join Date
    Sep 2005
    Posts
    37
    JD,
    Any luck with looking at my coding?

    Thanks.
    Bruce

  9. #9
    Join Date
    Mar 2009
    Location
    Dorset
    Posts
    119
    Bruce,
    Sorry, I have been away for a few days.
    Check out the attached db I have amended - hopefully it's what you are after.

    NB: I converted it to 2003 but it should still work the same in 2007.
    Attached Files Attached Files
    Regards
    JD

    Software-Matters

  10. #10
    Join Date
    Sep 2005
    Posts
    37
    JD,

    Thanks for looking at this. I'm having the same problem you had with the zip file being corrupted. Could you rename the original db and post it like I did with mine?

    Thanks.
    Bruce

  11. #11
    Join Date
    Mar 2009
    Location
    Dorset
    Posts
    119
    Here ya go...
    Attached Files Attached Files
    Regards
    JD

    Software-Matters

  12. #12
    Join Date
    Sep 2005
    Posts
    37
    That's it! Thanks a bunch JD. I knew there was more to it than what I was doing, but wasn't sure how to go about it. I really do appreciate your help.

    Bruce

  13. #13
    Join Date
    Mar 2009
    Location
    Dorset
    Posts
    119
    No problems. Glad to have helped.
    Regards
    JD

    Software-Matters

  14. #14
    Join Date
    Feb 2012
    Posts
    2

    Can I get help with a simular problem?

    The code below does not exit properly on the internal loop - any suggestions?

    #######################

    With MyRS
    Do Until .EOF

    KMLF = MyRS.Fields(0)

    Print #1, "<Folder>"
    Print #1, "<name>" & MyRS.Fields(0) & ": " & MyRS.Fields(1) & "</name>"
    Print #1, "<Open>0</Open>"

    Do While KMLF = MyRS.Fields(0)

    Print #1, " <Placemark>"
    Print #1, " <name>" & MyRS.Fields(0) & "</name>"
    Print #1, " <description>"

    Print #1, " <table>"
    Print #1, " <tr><td><B>REQUEST TYPE:</B></td></tr>"
    Print #1, " <tr><td>" & MyRS.Fields(1) & "</td></tr>"
    Print #1, " <tr><td><B>STATE:</B></td></tr>"
    Print #1, " <tr><td>" & MyRS.Fields(3) & "</td></tr>"
    Print #1, " <tr><td><B>COUNTY:</B></td></tr>"
    Print #1, " <tr><td>" & MyRS.Fields(7) & "</td></tr>"
    Print #1, " <tr><td><B>CONTACT TYPE:</B></td></tr>"
    Print #1, " <tr><td>" & MyRS.Fields(8) & "</td></tr>"
    Print #1, " <tr><td><B>REQUEST ID:</B></td></tr>"
    Print #1, " <tr><td>" & MyRS.Fields(6) & "</td></tr>"
    Print #1, " </table>"

    Print #1, " </description>"
    Print #1, " <styleUrl>#m_ylw-pushpin</styleUrl>"
    Print #1, " <Point>"
    strText = " <coordinates>" & MyRS.Fields(5) & "," & MyRS.Fields(4) & "</coordinates>"
    Print #1, strText
    Print #1, " </Point>"
    Print #1, " </Placemark>"

    .MoveNext
    Loop
    Print #1, "</Folder>"
    KMLF = KMLF + 1
    Loop

    End With

    Print #1, "</Document>"
    Print #1, "</kml>"

    Egress:
    On Error Resume Next
    Close #1
    MyRS.Close
    Set MyRS = Nothing
    Set MyDB = Nothing
    MsgBox "KML file output to database reference directory!"
    Exit Function

  15. #15
    Join Date
    Mar 2009
    Location
    Dorset
    Posts
    119
    Your .MoveNext needs to be outside of the loops as below:

    Loop
    Print #1, "</Folder>"
    KMLF = KMLF + 1
    Loop
    .MoveNext
    Regards
    JD

    Software-Matters

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •