FoolzRailer
New member
- Local time
- Today, 04:04
- Joined
- Apr 15, 2016
- Messages
- 25
I have a VBA-function that currently joins two queries and finds the XY in sequence between two and exports it in a seperate file (export not shown).
I also have a different function that exports a table in a very specific format needed for it to be importable in another program. Instead of exporting to a seperate file in the JoinTables function I need to get the XY from that function into the Export_VBK_Samlet() function. I'm unsure of how I get the data from JoinTables into the
The JoinTables and get XY values, I also had an export function sub below this, but that isn't needed as the XYs need to be part of the other functions output.
My current transpose and export function, where I need to get the Case "XY" (only in the lower part of the function) replaced with the data I find in the above JoinTables function. It also needs to be in the correct order and joined with the correct ID. How do I merge my above function into this?
Expected output would like something like this in .vbk file (txt).
$KNUDE '01'
XY 1830.99 106.05
Z_F 40.10
DYBDE 1.20
....more data followed by more $Knude
$LEDNING '02' '03' 1
XY 1859.72 105.71
XY 1884.26 105.94 (can have just one or a lot of these XYs as they denote vertices)
FRA_Z 38.78
TIL_Z 38.70
....more data followed by more $Ledning
$LEDNING '05' '06' 1
XY 1884.26 105.94 (can have just one or a lot of these XYs as they denote vertices)
FRA_Z 38.98
TIL_Z 38.78
....more data followed by more $Ledning
I also have a different function that exports a table in a very specific format needed for it to be importable in another program. Instead of exporting to a seperate file in the JoinTables function I need to get the XY from that function into the Export_VBK_Samlet() function. I'm unsure of how I get the data from JoinTables into the
The JoinTables and get XY values, I also had an export function sub below this, but that isn't needed as the XYs need to be part of the other functions output.
Code:
Sub JoinTables()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim strSQL As String
Dim tempData() As Variant ' Temporary array to store the retrieved data
' Set references to the database and recordsets
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("VBK_Ledninger_TXT") ' Table 1: VBK_Ledninger_TXT
' Loop through the first table
rs1.MoveFirst
Do While Not rs1.EOF
' Get the ID from the first table
Dim ID As Long
ID = rs1("ID")
' Build the SQL statement to retrieve data from the second table with sorting
strSQL = "SELECT * FROM [Vejvand_Udtræk til Linjer] WHERE ID=" & ID & " ORDER BY ID ASC, Sortering ASC"
' Execute the SQL statement and retrieve the data
Set rs2 = db.OpenRecordset(strSQL, dbOpenSnapshot)
' Loop through the second table and store the XKoordinat and YKoordinat values in the temporary array
Dim X As Double
Dim Y As Double
rs2.MoveFirst
Do While Not rs2.EOF
' Get the XKoordinat and YKoordinat values from the second table
X = rs2("XKoordinat")
Y = rs2("YKoordinat")
' Move to the next record in the second table
rs2.MoveNext
Loop
' Close the recordset for the second table
rs2.Close
Set rs2 = Nothing
' Move to the next record in the first table
rs1.MoveNext
Loop
' Close the recordsets and database
rs1.Close
Set rs1 = Nothing
db.Close
Set db = Nothing
End SubMy current transpose and export function, where I need to get the Case "XY" (only in the lower part of the function) replaced with the data I find in the above JoinTables function. It also needs to be in the correct order and joined with the correct ID. How do I merge my above function into this?
Code:
Option Compare Database
Option Explicit
Public Function Export_VBK_Samlet()
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
' 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")
var = Replace(var, ",", ".")
Case "XY", "TEXTXY", "Z_F", "DYBDE", "OB", "PERPEND", "Q", "STATION", "PERPEND", "AFSTRØM"
var = Format$(var, "0.00")
var = Replace(var, ",", ".")
Case "DIMENSION"
var = Format$(var, "0.000")
var = Replace(var, ",", ".")
Case "OPLAND"
var = Format$(var, "0.0000")
var = Replace(var, ",", ".")
End Select
Print #fnum, fd.Name & " " & var
Next
.MoveNext
If Not (.EOF) Then
Print #fnum, ""
End If
Loop
.Close
End With
Set rst = dbs.OpenRecordset("VBK_Ledning_TXT", dbOpenSnapshot, dbReadOnly)
Print #fnum, ""
With rst
If Not (.BOF And .EOF) Then
.MoveFirst
OK = True
End If
Do Until .EOF
For Each fd In .Fields
var = fd.Value
Select Case fd.Name
Case "AFLKOEF", "FALD", "MANNING", "ACCU_Q"
var = Format$(var, "0.0")
var = Replace(var, ",", ".")
Case "XY", "TEXTXY", "FRA_Z", "TIL_Z", "LÆNGDE", "PERPEND", "REDUKTION", "EXTRA_OB", "PERPEND", "AFSTRØM" /The Case"XY" I think I need to replace
var = Format$(var, "0.00")
var = Replace(var, ",", ".")
If fd.Name = "XY" Then
foundXY = True
End If
Case "DIMENSION"
var = Format$(var, "0")
var = Replace(var, ",", ".")
End Select
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
End FunctionExpected output would like something like this in .vbk file (txt).
$KNUDE '01'
XY 1830.99 106.05
Z_F 40.10
DYBDE 1.20
....more data followed by more $Knude
$LEDNING '02' '03' 1
XY 1859.72 105.71
XY 1884.26 105.94 (can have just one or a lot of these XYs as they denote vertices)
FRA_Z 38.78
TIL_Z 38.70
....more data followed by more $Ledning
$LEDNING '05' '06' 1
XY 1884.26 105.94 (can have just one or a lot of these XYs as they denote vertices)
FRA_Z 38.98
TIL_Z 38.78
....more data followed by more $Ledning
Last edited:
