FoolzRailer
New member
- Local time
- Today, 06:59
- Joined
- Apr 15, 2016
- Messages
- 25
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.
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):
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.
Code:
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):