Add query data to existing export function (1 Viewer)

[FoolzRailer]

Hello

I'm trying to add some data to an VBA-export function I created a while ago. Basically I need to add the data from the table Stik_Samling to the bottom of my first export function with OpenRecordset VBK_Knude.

However I've run into a few issues, the number of columns in Stik_Samling can vary for each row, so it might not just be 3 as shown in the example, it could be 2 or 5, so needs to loop through this. Then it needs to be placed under the correct KnudeID/Knudenavn/$Knude in the export, so it matches. I tried on my own first, with the strSql_ bit I've since commented out in the code.

Any help would be much appreciated! I've added the code and some pictures.

Public Function Export_VBK_Samlet_v1()

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim fd As DAO.Field
    Dim fnum As Integer
    Dim path As String
    Dim OK As Boolean
    Dim var As Variant
    Dim foundXY As Boolean
    Dim ff As Long
    Dim strSql As String
    ' export to this file
    path = FilToSave
 
    fnum = FreeFile
 
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("VBK_Knude", dbOpenSnapshot, dbReadOnly)
 
    With rst
        If Not (.BOF And .EOF) Then
            .MoveFirst
            OK = True
            Open path For Output As fnum
        End If
      
        Do Until .EOF
            For Each fd In .Fields
                var = fd.Value
                Select Case fd.Name
                    Case "AFLKOEF"
                        var = Format$(var, "0.0")
                    Case "XY", "TEXTXY", "Z_F", "DYBDE", "OB", "PERPEND", "Q", "STATION", "PERPEND", "AFSTRØM"
                        var = Format$(var, "0.00")
                    Case "DIMENSION"
                        var = Format$(var, "0.000")
                    Case "OPLAND"
                        var = Format$(var, "0.0000")
                End Select
                var = Replace(var, ",", ".")
                Print #fnum, fd.Name & " " & var
            Next

            ' Retrieve XY value from the new query result
            ' strSql = "TRANSFORM Min([Stik_XY].[Xkoordinat] & "" "" & [Stik_XY].[Ykoordinat]) AS XY_Stik " & _
                    ' "SELECT [Stik_XY].[KnudeNavn] " & _
                     "FROM Stik_XY " & _
                     "GROUP BY [Stik_XY].[Knudenavn] " & _
                     "PIVOT [Stik_XY].[Sortering];"

            ' Set xyRst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbReadOnly)
            ' xyRst.FindFirst "[Stik_XY].[$Knude]" = "[VBK_Knude].[$Knude]"
            ' If Not xyRst.NoMatch Then
            '     Print #fnum, "XY_Stik " & xyRst("XY")
            ' End If
            ' xyRst.Close
            ' Set xyRst = Nothing

            .MoveNext
            If Not (.EOF) Then
                Print #fnum, ""
            End If
        Loop
        .Close
    End With
 
 
[SPOILER="Rest of code"]    Set rst = dbs.OpenRecordset("VBK_Ledninger_TXT", dbOpenSnapshot, dbReadOnly)
    Print #fnum, ""
    With rst
        If Not (.BOF And .EOF) Then
            .MoveFirst
            OK = True
        End If
                Do Until .EOF
            Print #fnum, "$LEDNING" & " " & rst.Fields("$LEDNING")
            strSql = "SELECT v.ID, v.XKoordinat, v.YKoordinat " & _
                    "FROM [Vejvand_Udtræk til Linjer] v " & _
                    "WHERE v.ID = " & rst!ID & _
                    " ORDER BY v.Sortering;"
            With dbs.OpenRecordset(strSql)
            Do While Not .EOF
                ' Replace commas with dots in XKoordinat and YKoordinat fields
                Dim xCoord As String
                Dim yCoord As String
                xCoord = Replace(.Fields("XKoordinat"), ",", ".")
                yCoord = Replace(.Fields("YKoordinat"), ",", ".")
                Print #fnum, "XY " & xCoord & " " & yCoord
                .MoveNext
              Loop
              .Close
            End With
            For Each fd In .Fields
            If fd.Name <> "ID" Then ' Skip the ID field
                var = fd.Value
                Select Case fd.Name
                    Case "$LEDNING"
                        var = vbNullString
                    Case "AFLKOEF", "FALD", "MANNING", "ACCU_Q"
                        var = Format$(var, "0.0")
                    Case "TEXTXY", "FRA_Z", "TIL_Z", "LÆNGDE", "REDUKTION", "EXTRA_OB", "PERPEND", "AFSTRØM"
                        var = Format$(var, "0.00")
                    Case "DIMENSION"
                        var = Format$(var, "0")
                End Select
                If Not IsNull(var) Then
                var = Replace(var, ",", ".")
                End If
                If Len(var) Then
                  Print #fnum, fd.Name & " " & var
                End If
                End If
            Next
            .MoveNext

            If Not (.EOF) Then
                Print #fnum, ""
            End If
        Loop
        .Close
    End With
 
    Set rst = Nothing
    Set dbs = Nothing
 
    If OK Then
        Close #fnum
        MsgBox "VBK eksporteret til " & path
    End If[/SPOILER]

End Function

Datasheet view followed by the Design view of the query of VBK_Knude. Can also add the SQL if needed. I've also shown the Stik_Samling below, that needs the data joined in my export.

The desired output should look like this as a .vbk file (can be opened as txt in notepad just fyi):

 

[MarkK]

I would break this code into subroutines. Dealing with this as a single routine makes it hard to understand, hard to maintain, hard to debug, etc...

As a rule of thumb, one subroutine should do one thing. If you need to open a second recordset, for instance, do that in a subroutine. If you need to enumerate all the fields in a row, do that in a subroutine. If you need to return formatted values, write a function.

Doing all these different tasks in a single procedure is like juggling. If you want to become a juggler, ok, but typically the most important objective is to not drop anything. To not drop anything, deal with each single task, one at a time, in a Sub, Function or Property.

Happy coding,