meine neueste errungenschaft
*wieder stück weiter ist*
Option Compare Database
Public Sub import_las_button_Click()
Dim str As String 'String
Dim v As Variant 'Split
Dim delim As String 'Delimiter zur Stringtrennung
Dim datastart As String 'Zeichenfolge die im LAS-File direkt vor Datenbeginn steht - default "~A"
Dim datastarted As Boolean '"True" wenn der Datastart-String gesichtet wurde
Dim strl As Long 'String-Länge
Dim logpath As String 'Dateipfad
Dim i As Integer 'Laufvariable
Dim strSQL As String 'SQL String
Dim dept() As String 'Depth
Dim sw() As String 'Formation Water Saturation <=1.0 (Complex Litho Model)
Dim phie() As String 'Effective Porosity (Complex Litho Model)
Dim vcl() As String 'Volume of clay (Complex Litho Model)
Dim devi() As String 'Deviation
Dim tvd() As String 'True Vertical Depth
logpath = "C:\**********************\Chris\LogRep V2\Dataimport\dummy.las"
delim = " " 'Trennzeichen zwischen den Werten in der LAS/TXT
datastart = "~A"
datastarted = False
'Temporären Table für die LAS Daten erstellen.
strSQL = "CREATE TABLE Las_Temp" & _
" (val1 NUMBER NOT NULL," & _
" val2 NUMBER NOT NULL," & _
" val3 NUMBER NOT NULL," & _
" val4 NUMBER NOT NULL," & _
" val5 NUMBER NOT NULL," & _
" val6 NUMBER NOT NULL )"
DoCmd.RunSQL (strSQL)
Open logpath For Input As 1
ReDim Preserve dept(0)
ReDim Preserve sw(0)
ReDim Preserve phie(0)
ReDim Preserve vcl(0)
ReDim Preserve devi(0)
ReDim Preserve tvd(0)
status_txt.Value = "Importing data... "
Do While Not EOF(1)
If datastarted = True Then
Line Input #1, str
'doppelte trennzeichen entfernen
Do While InStr(str, delim & delim)
str = Replace(str, delim & delim, delim)
Loop
'übrig gebliebenes trennzeichen vor dem ersten wert entfernen
strl = Len(str)
str = Right(str, strl - 1)
'string trennen
v = Split(str, delim)
dept(UBound(dept)) = v(0)
sw(UBound(sw)) = v(1)
phie(UBound(phie)) = v(2)
vcl(UBound(vcl)) = v(3)
devi(UBound(devi)) = v(4)
tvd(UBound(tvd)) = v(5)
'werte in temporären table schreiben
strSQL = "INSERT INTO Las_Temp (val1, val2, val3, val4, val5, val6) " & _
"SELECT '" & v(0) & "', '" & v(1) & "', '" & v(2) & "', '" & v(3) & "', '" & v(4) & "', '" & v(5) & "'"
CurrentDb.Execute (strSQL)
ReDim Preserve dept(UBound(dept) + 1)
ReDim Preserve sw(UBound(sw) + 1)
ReDim Preserve phie(UBound(phie) + 1)
ReDim Preserve vcl(UBound(vcl) + 1)
ReDim Preserve devi(UBound(devi) + 1)
ReDim Preserve tvd(UBound(tvd) + 1)
Else
Line Input #1, str
If InStr(str, datastart) Then
datastarted = True
Else
datastarted = False
End If
End If
Loop
Close 1
status_txt.Value = "Done."
End Sub
\o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/ \o/
weeeeeeeeeeeeeee!!