|
Question : Tweak needed in Access VB Code
|
|
Hey Experts,
I have a text file that looks like this....
From: Ground Station
[[email protected]pany]
Sent: Thursday, February 24, 2005 7:03 AM
To: recipient
06976 Date : 21.02.05 13:00:02 LC : B IQ : 00
Lat1 : 65.565N Lon1 : 103.799W Lat2 : 75.753N Lon2 : 160.651W
Nb mes : 002 Nb mes>-120dB : 000 Best level : -136 dB
Pass duration : 066s NOPC : 1
Calcul freq : 401 651152.8 Hz Altitude : 0 m
00 78 16 112
06976 Date : 21.02.05 13:10:29 LC : Z IQ : 00
Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ????????
Nb mes : 001 Nb mes>-120dB : 000 Best level : -136 dB
Pass duration : ? s NOPC : ?
Calcul freq : 401 650000.0 Hz Altitude : 0 m
00 78 09 112
06976 Date : 21.02.05 14:12:05 LC : Z IQ : 00
Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ????????
Nb mes : 001 Nb mes>-120dB : 000 Best level : -131 dB
Pass duration : ? s NOPC : ?
Calcul freq : 401 650000.0 Hz Altitude : 0 m
00 63 06 112
etc....
And using this code..... (thanks to Capricorn1)
Private Sub cmdImportTextFiles_Click()
Dim i As Long, j As Long, x As Long, iSQL As String, fName As String
Dim sText As String, txt1 As String
Dim eDate As Date, sColr As String, fDate As String, fTime As String
Dim sLC As String, sLon1 As String, sLat1 As String, sAct As String
fName = "C:\TextCsvFiles\2005_21Feb23_Loc.txt" 'change this to where your file is
Open fName For Input As #1 'open file for input
Line Input #1, sText
Do Until InStr(sText, "Sent:") > 0
Line Input #1, sText
Loop
If InStr(1, sText, "Sent:") Then
i = InStr(sText, ",")
eDate = Mid(sText, i + 1, Len(sText) - (i - 1))
eDate = CDate(Format(eDate, "mm/dd/yyyy"))
End If
Do While Not EOF(1) 'for more than one line
Do Until InStr(sText, "Date") > 0
Line Input #1, sText
Loop
If InStr(sText, "Date") Then
txt1 = txt1 & sText
Line Input #1, sText
txt1 = txt1 & sText
txt1 = Replace(Replace(Replace(Trim(txt1), ":", ""), " ", ":"), "::", ":")
x = InStr(1, txt1, ":")
sColr = Left(txt1, InStr(1, txt1, ":") - 1)
fDate = Mid(txt1, InStr(x + 1, txt1, ":") + 1)
fDate = Left(fDate, InStr(1, fDate, ":") - 1)
fDate = Left(fDate, 2) & "/" & Mid(fDate, 4, 2) & "/" & Right(fDate, 2)
x = InStr(1, txt1, ":")
fTime = Mid(txt1, InStr(x + 1, txt1, ":") + 1)
fTime = Left(fDate, InStr(1, fTime, ":") - 1)
fTime = Left(fTime, 2) & ":" & Mid(fTime, 4, 2) & ":" & Right(fTime, 2)
x = InStr(x + 1, txt1, "LC")
sLC = Mid(txt1, InStr(x + 1, txt1, ":") + 1)
sLC = Left(sLC, InStr(1, sLC, ":") - 1)
x = InStr(x + 1, txt1, "Lat1")
sLat1 = Mid(txt1, InStr(x, txt1, ":") + 1)
sLat1 = Left(sLat1, InStr(1, sLat1, ":") - 1)
x = InStr(x + 1, txt1, "Lon1")
sLon1 = Mid(txt1, InStr(x, txt1, ":") + 1)
sLon1 = Left(sLon1, InStr(1, sLon1, ":") - 1)
Do Until InStr(sText, "Altitude") > 0
Line Input #1, sText
Loop
Line Input #1, sText
sText = Trim(sText)
sAct = Right(sText, 2)
End If
iSQL = "insert into tblJonat(EmailDate,CollarNumber,Fix_Date,Fix_Time,LC,Lat1,Lon1,Activity) "
iSQL = iSQL & "Values(#" & eDate & "#,'" & sColr & "','" & fDate & "', "
iSQL = iSQL & "'" & fTime & "','" & sLC & "','" & sLat1 & "','" & sLon1 & "','" & sAct & "')"
CurrentDb.Execute (iSQL), dbFailOnError
txt1 = ""
sText = ""
Loop
End Sub
....I am able to place certain text in a table...namely EmailDate, Collar Number, Fix_Date, Fix_Time, LC, LAT1, LON1 and the very last number (112 in the example text above).
Here is my question....
I need to tweak the above code to do the same thing on a similiar text file, but with differences in Email headings, and the data body. An example of a the different text file is below.....
Received: from ntserver.argosinc.com (ntserver.argosinc.com [198.116.24.10]) by bison.arctic.ca (8.6.9/8.6.9) with SMTP id GAA00793 for ; Fri, 5 Jun 1998 06:58:57 -0500
Received: from alpha5.argosinc.com [198.116.24.6]
(HELO alpha5)
by ntserver.argosinc.com (AltaVista Mail V2.0I/2.0I BL25I listener)
id 0000_0068_3577_ddec_3039;
Fri, 05 Jun 1998 08:00:44 -0400
Date: Fri, 5 Jun 1998 12:05:29 GMT
Message-Id: <[email protected]om>
From: [email protected] (Automatic Distribution Service (301) 925 4411)
To: [email protected]
X-VMS-To: smtp%"[email protected]"
06976 Date : 01.06.98 14:27:20 LC : 1 IQ : 58
Lat1 : 64.235N Lon1 : 88.893W Lat2 : 83.637N Lon2 : 106.428E
Nb mes : 006 Nb mes>-120dB : 000 Best level : -126 dB
Pass duration : 329s NOPC : 4
Calcul freq : 401 650212.3 Hz Altitude : 300 m
00 100 00 89
etc...
Please keep in mind that the above example's top 3 lines are really only on one line in a real text file.
Any quick advice would be greatly appreciated.
JonathanPameolik
|
|
|
Answer : Tweak needed in Access VB Code
|
|
try this
Open fName For Input As #1 'open file for input
Line Input #1, sText
Do Until InStr(sText, "Sent:") > 0 Or InStr(sText, "Date:") > 0
Line Input #1, sText
Loop
If InStr(1, sText, "Sent:") Then
i = InStr(sText, ",")
eDate = Mid(sText, i + 1, Len(sText) - (i - 1))
eDate = CDate(Format(eDate, "mm/dd/yyyy"))
Else
sText = Left(sText, InStrRev(sText, " "))
i = InStr(sText, ",")
eDate = Mid(sText, i + 1, Len(sText) - (i - 1))
eDate = CDate(Format(eDate, "mm/dd/yyyy"))
sText = ""
End If
Do While Not EOF(1) 'for more than one line
Do Until InStr(sText, "Date") > 0
Line Input #1, sText
Loop
If InStr(sText, "Date") Then
txt1 = txt1 & sText
Line Input #1, sText
txt1 = txt1 & sText
txt1 = Replace(Replace(Replace(Trim(txt1), ":", ""), " ", ":"), "::", ":")
x = InStr(1, txt1, ":")
sColr = Left(txt1, InStr(1, txt1, ":") - 1)
fDate = Mid(txt1, InStr(x + 1, txt1, ":") + 1)
fDate = Left(fDate, InStr(1, fDate, ":") - 1)
fDate = Left(fDate, 2) & "/" & Mid(fDate, 4, 2) & "/" & Right(fDate, 2)
x = InStr(1, txt1, ":")
fTime = Mid(txt1, InStr(x + 1, txt1, ":") + 1)
fTime = Left(fDate, InStr(1, fTime, ":") - 1)
fTime = Left(fTime, 2) & ":" & Mid(fTime, 4, 2) & ":" & Right(fTime, 2)
x = InStr(x + 1, txt1, "LC")
sLC = Mid(txt1, InStr(x + 1, txt1, ":") + 1)
sLC = Left(sLC, InStr(1, sLC, ":") - 1)
x = InStr(x + 1, txt1, "Lat1")
sLat1 = Mid(txt1, InStr(x, txt1, ":") + 1)
sLat1 = Left(sLat1, InStr(1, sLat1, ":") - 1)
x = InStr(x + 1, txt1, "Lon1")
sLon1 = Mid(txt1, InStr(x, txt1, ":") + 2)
sLon1 = Left(sLon1, InStr(1, sLon1, ":") - 1)
Do Until InStr(sText, "Altitude") > 0
Line Input #1, sText
Loop
Line Input #1, sText
sText = Trim(sText)
sAct = Right(sText, 2)
End If
iSQL = "insert into tblJonat(EmailDate,CollarNumber,Fix_Date,Fix_Time,LC,Lat1,Lon1,Activity) "
iSQL = iSQL & "Values(#" & eDate & "#,'" & sColr & "','" & fDate & "', "
iSQL = iSQL & "'" & fTime & "','" & sLC & "','" & sLat1 & "','" & sLon1 & "','" & sAct & "')"
CurrentDb.Execute (iSQL), dbFailOnError
txt1 = ""
sText = ""
Loop
|
|
|
|
|
