btgay. immer noch kein ende in sicht punkto "datei einlesen"-button :|
HTML-Code:
Public Sub import_las_button_Click()
Dim str As String ' String
Dim v As Variant ' Split
Dim kid As Variant ' Key ID Split
Dim delim As String ' Delimiter zur Stringtrennung
Dim petrolog_datastart As String ' PETROLOG Zeichenfolge die im LAS-File direkt vor Datenbeginn steht
Dim geoframe_datastart As String ' GEOFRAME Zeichenfolge die im LAS-File direkt vor Datenbeginn steht
Dim geoframe_stpstr As String ' Zeichenfolge die im LAS-File direkt vor der STEP angabe steht
Dim petrolog_stpstr As String ' Zeichenfolge die im LAS-File direkt vor der STEP angabe steht
Dim ci_string As String ' Zeichenfolge die im LAS-File zu Beginn der Kurvendefinitionen steht
Dim wi_string As String ' Zeichenfolge die im LAS-File zu Beginn der Bohrungs Informationen steht
Dim petrolog_las As Boolean ' Wurde das LAS-File mit PETROLOG erstellt? TRUE/FALSE
Dim geoframe_las As Boolean ' Wurde das LAS-File mit GEOFRAME erstellt? TRUE/FALSE
Dim datastarted As Boolean ' TRUE wenn der Datastart-String gesichtet wurde
Dim cinfostarted As Boolean ' TRUE wenn innerhalb der Curve Information Sektion eingelesen wird
Dim winfostarted As Boolean ' TRUE wenn innerhalb der Well Info Sektion eingelesen wird
Dim currentrow As Integer ' Aktuelle Zeile
Dim curveinformation_row As Integer ' Zeilennummer des Curve Information Blocks
Dim wellinformation_row As Integer ' Zeilennummer des Well Information Blocks
Dim curve1_desc As String ' Kurve 1
Dim curve2_desc As String ' Kurve 2
Dim curve3_desc As String ' Kurve 3
Dim curve4_desc As String ' Kurve 4
Dim curve5_desc As String ' Kurve 5
Dim curve6_desc As String ' Kurve 6
Dim curve1_row As String ' curve1_desc in Row
Dim curve2_row As String ' curve2_desc in Row
Dim curve3_row As String ' curve3_desc in Row
Dim curve4_row As String ' curve4_desc in Row
Dim curve5_row As String ' curve5_desc in Row
Dim curve6_row As String ' curve6_desc in Row
Dim curve1_row_found As Boolean ' Bereits fündig gewesen?
Dim curve2_row_found As Boolean ' Bereits fündig gewesen?
Dim curve3_row_found As Boolean ' Bereits fündig gewesen?
Dim curve4_row_found As Boolean ' Bereits fündig gewesen?
Dim curve5_row_found As Boolean ' Bereits fündig gewesen?
Dim curve6_row_found As Boolean ' Bereits fündig gewesen?
Dim strl As Long ' String-Länge
Dim logpath As String ' Dateipfad
Dim i As Long ' 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
Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, "Las Files (*.las)", "*.LAS")
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
logpath = ahtCommonFileOpenSave(InitialDir:="C:\", Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, DialogTitle:="Import .LAS")
delim = " " 'Trennzeichen zwischen den Werten in der LAS/TXT
petrolog_stpstr = "STEP .M"
geoframe_stpstr = "STEP.M"
ci_string = "~C"
wi_string = "~W"
petrolog_datastart = "~A"
geoframe_datastart = "~Ascii Data Section"
curve1_desc = "DEPT"
curve2_desc = "SW-CPX"
curve3_desc = "PHIE-CPX"
curve4_desc = "VCL-CPX"
curve5_desc = "DEVI"
curve6_desc = "TVD"
datastarted = False
geoframe_las = False
petrolog_las = False
winfostarted = False
cinfostarted = False
curve1_row_found = False
curve2_row_found = False
curve3_row_found = False
curve4_row_found = False
curve5_row_found = False
curve6_row_found = False
currentrow = 0
strSQL = "CREATE Table Las_Temp " & _
"(DataID INTEGER, " & _
"GroupID INTEGER, " & _
"datavisible YESNO, " & _
"val1 NUMBER, " & _
"val2 NUMBER, " & _
"val3 NUMBER, " & _
"val4 NUMBER, " & _
"val5 NUMBER, " & _
"val6 NUMBER)"
DoCmd.RunSQL (strSQL)
Open logpath For Input As 1
i = 0
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)
'werte in temporären table schreiben
strSQL = "INSERT INTO Las_Temp (DataID, val1, val2, val3, val4, val5, val6) " & _
"SELECT '" & i & "', '" & v(0) & "', '" & v(1) & "', '" & v(2) & "', '" & v(3) & "', '" & v(4) & "', '" & v(5) & "'"
CurrentDb.Execute (strSQL)
i = i + 1
Else
Line Input #1, str
If InStr(str, geoframe_stpstr) Or InStr(str, petrolog_stpstr) Then
'doppelte leerzeichen löschen
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)
v = Split(str, delim)
stepping = v(1)
stepping_txt.Value = stepping
End If
If InStr(str, wi_string) Then
winfostarted = True
End If
If InStr(str, ci_string) Then
winfostarted = False
cinfostarted = True
wellinformation_row = currentrow
End If
'GEOFRAME Datenbeginn
If InStr(str, geoframe_datastart) Then
cinfostarted = False
geoframe_las = True
datastarted = True
End If
'PETROLOG Datenbeginn
If InStr(str, petrolog_datastart) Then
cinfostarted = False
petrolog_las = True
datastarted = True
End If
If InStr(str, curve1_desc) And curve1_row_found = False And cinfostarted = True Then
curve1_row = currentrow
curve1_row_found = True
End If
If InStr(str, curve2_desc) And curve2_row_found = False And cinfostarted = True Then
curve2_row = currentrow
curve2_row_found = True
End If
If InStr(str, curve3_desc) And curve3_row_found = False And cinfostarted = True Then
curve3_row = currentrow
curve3_row_found = True
End If
If InStr(str, curve4_desc) And curve4_row_found = False And cinfostarted = True Then
curve4_row = currentrow
curve4_row_found = True
End If
If InStr(str, curve5_desc) And curve5_row_found = False And cinfostarted = True Then
curve5_row = currentrow
curve5_row_found = True
End If
If InStr(str, curve6_desc) And curve6_row_found = False And cinfostarted = True Then
curve6_row = currentrow
curve6_row_found = True
End If
End If
currentrow = currentrow + 1
Loop
Close 1
MsgBox curve1_desc & "@" & curve1_row & " " & curve2_desc & "@" & curve2_row & " " & curve3_desc & "@" & curve3_row & " " & curve4_desc & "@" & curve4_row & " " & curve5_desc & "@" & curve5_row & " " & curve6_desc & "@" & curve6_row
setroot
buildtree
writelist
End Sub