E
Eskimo
Hi, I have this import routine to convert a text file with a certain
structure(below code, in first example.)
The text structure changed just slightly in that there is no more empty line
(with a space) between each block
of information. (See way below, new email text structure.)
This has adverse effects in the routine that it does not know now to loop
through each block.
I need a slight change in the "Case Else" section of the code below to start
the next block of information.
I am not familiar with VBA and its going way over my head.
Thanks in advance, Eskimo
Here is the code...
Sub ConvertFile()
Dim LCStart As Long
Dim IQStart As Long
Dim Lat1Start As Long
Dim Lon1Start As Long
Dim Lat2Start As Long
Dim Lon2Start As Long
Dim NbmesStart As Long
Dim Nbmes2Start As Long
Dim BestLevelStart As Long
Dim PassDurStart As Long
Dim NOPCStart As Long
Dim CalcFreqStart As Long
Dim AltStart As Long
Dim Num1Start As Long
Dim Num2Start As Long
Dim Num3Start As Long
Dim Num4Start As Long
Dim LineIn As String
Dim RecNo As Long
Dim RecLine As Long
Dim aryData As Variant
Dim maxRecords As Long
Dim recColumns As Long
maxRecords = 17000
recColumns = 20
Worksheets("Raw Data").UsedRange.Offset(1, 0).Resize(maxRecords,
recColumns).EntireRow.Delete
aryData = Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords,
recColumns)
ChDrive Left(ActiveWorkbook.Path, 1)
ChDir ActiveWorkbook.Path
'FName = Range("FName").Value
Open Range("FName") For Input As #1
RecNo = 2
RecLine = 0
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, LineIn ' Read line into variable.
RecLine = RecLine + 1
Select Case RecLine
Case 1
LCStart = WorksheetFunction.Find("LC :", LineIn)
IQStart = WorksheetFunction.Find("IQ :", LineIn)
aryData(RecNo, 1) = Mid(LineIn, 2, 5)
aryData(RecNo, 2) = WorksheetFunction.Substitute(Mid(LineIn, 15, 8),
".", "/")
aryData(RecNo, 3) = TimeValue(Mid(LineIn, 24, 8))
aryData(RecNo, 4) = Trim(Mid(LineIn, LCStart + 4, IQStart - (LCStart
+ 4)))
aryData(RecNo, 5) = Trim(Mid(LineIn, IQStart + 4))
Case 2
Lat1Start = WorksheetFunction.Find("Lat1 :", LineIn)
Lat2Start = WorksheetFunction.Find("Lat2 :", LineIn)
Lon1Start = WorksheetFunction.Find("Lon1 :", LineIn)
Lon2Start = WorksheetFunction.Find("Lon2 :", LineIn)
aryData(RecNo, 6) = Trim(Mid(LineIn, Lat1Start + 6, Lon1Start -
(Lat1Start + 6)))
aryData(RecNo, 7) = Trim(Mid(LineIn, Lon1Start + 6, Lat2Start -
(Lon1Start + 6)))
aryData(RecNo, 8) = Trim(Mid(LineIn, Lat2Start + 6, Lon2Start -
(Lat2Start + 6)))
aryData(RecNo, 9) = Trim(Mid(LineIn, Lon2Start + 6))
Case 3
NbmesStart = WorksheetFunction.Find("Nb mes :", LineIn)
Nbmes2Start = WorksheetFunction.Find("Nb mes>-120dB :", LineIn)
BestLevelStart = WorksheetFunction.Find("Best level :", LineIn)
aryData(RecNo, 10) = Trim(Mid(LineIn, NbmesStart + 8, Nbmes2Start -
(NbmesStart + 8)))
aryData(RecNo, 11) = Trim(Mid(LineIn, Nbmes2Start + 15,
BestLevelStart - (Nbmes2Start + 15)))
aryData(RecNo, 12) = Trim(Mid(LineIn, BestLevelStart + 12))
Case 4
PassDurStart = WorksheetFunction.Find("Pass duration :", LineIn)
NOPCStart = WorksheetFunction.Find("NOPC :", LineIn)
aryData(RecNo, 13) = Trim(Mid(LineIn, PassDurStart + 15, NOPCStart -
(PassDurStart + 15)))
aryData(RecNo, 14) = Trim(Mid(LineIn, NOPCStart + 6))
Case 5
CalcFreqStart = WorksheetFunction.Find("Calcul freq :", LineIn)
AltStart = WorksheetFunction.Find("Altitude :", LineIn)
aryData(RecNo, 15) = Trim(Mid(LineIn, CalcFreqStart + 13, AltStart -
(CalcFreqStart + 13)))
aryData(RecNo, 16) = Trim(Mid(LineIn, AltStart + 10))
Case 6
Num1Start = WorksheetFunction.Find(" ", LineIn, 2)
Num2Start = WorksheetFunction.Find(" ", LineIn, Num1Start + 1)
Num3Start = WorksheetFunction.Find(" ", LineIn, Num2Start + 1)
Num4Start = WorksheetFunction.Find(" ", LineIn, Num3Start + 1)
aryData(RecNo, 17) = Trim(Mid(LineIn, Num1Start + 1, Num2Start -
(Num1Start + 1)))
aryData(RecNo, 18) = Trim(Mid(LineIn, Num2Start + 1, Num3Start -
(Num2Start + 1)))
aryData(RecNo, 19) = Trim(Mid(LineIn, Num3Start + 1, Num4Start -
(Num3Start + 1)))
aryData(RecNo, 20) = Trim(Mid(LineIn, Num4Start + 1))
Case Else
If LineIn = " " Then
RecLine = 0
RecNo = RecNo + 1
Else
MsgBox "Record number " & RecNo & " (collar number " &
aryData(RecNo, 1) & _
")" & Chr(10) & "has this additional line:" & _
Chr(10) & Chr(10) & LineIn, vbInformation, "Please note"
End If
End Select
Loop
Close
Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns)
= aryData
Worksheets("Raw Data").UsedRange.Offset(RecNo, 0).Resize(maxRecords + 1 -
RecNo).EntireRow.Delete
End Sub
Here below is the way it use to be...note the space in the empty line
between each block.
06979 Date : 26.11.04 13:18:02 LC : 0 IQ : 40
Lat1 : 65.607N Lon1 : 103.130W Lat2 : 66.861N Lon2 : 110.355W
Nb mes : 006 Nb mes>-120dB : 000 Best level : -132 dB
Pass duration : 483s NOPC : 2
Calcul freq : 401 649301.8 Hz Altitude : 144 m
00 2991 00 11
06979 Date : 26.11.04 14:09:13 LC : B IQ : 00
Lat1 : 65.503N Lon1 : 103.237W Lat2 : 54.304N Lon2 : 41.614W
Nb mes : 002 Nb mes>-120dB : 000 Best level : -133 dB
Pass duration : 138s NOPC : 2
Calcul freq : 401 649301.8 Hz Altitude : 0 m
00 2465 00 11
06979 Date : 26.11.04 14:09:48 LC : 0 IQ : 46
Lat1 : 65.586N Lon1 : 102.939W Lat2 : 64.211N Lon2 : 95.011W
Nb mes : 007 Nb mes>-120dB : 000 Best level : -130 dB
Pass duration : 483s NOPC : 2
Calcul freq : 401 649352.1 Hz Altitude : 134 m
00 2352 00 11
Here below is how the emails are now. note the lack of an empty line
between each blcok
as compared with that above.
06976 Date : 03.03.05 13:28:16 LC : 0 IQ : 50
Lat1 : 65.285N Lon1 : 100.524W Lat2 : 68.146N Lon2 : 115.915W
Nb mes : 004 Nb mes>-120dB : 000 Best level : -129 dB
Pass duration : 462s NOPC : 2
Calcul freq : 401 651572.3 Hz Altitude : 138 m
00 70 00 235
06976 Date : 03.03.05 14:12:16 LC : Z IQ : 00
Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ????????
Nb mes : 009 Nb mes>-120dB : 000 Best level : -128 dB
Pass duration : 594s NOPC : 0
Calcul freq : 401 650000.0 Hz Altitude : 0 m
00 54 55 235
06976 Date : 03.03.05 14:26:34 LC : 0 IQ : 53
Lat1 : 65.317N Lon1 : 100.425W Lat2 : 82.934N Lon2 : 141.492E
Nb mes : 006 Nb mes>-120dB : 000 Best level : -130 dB
Pass duration : 594s NOPC : 3
Calcul freq : 401 651187.5 Hz Altitude : 137 m
00 52 02 235
Any suggestions?
Eskimo
structure(below code, in first example.)
The text structure changed just slightly in that there is no more empty line
(with a space) between each block
of information. (See way below, new email text structure.)
This has adverse effects in the routine that it does not know now to loop
through each block.
I need a slight change in the "Case Else" section of the code below to start
the next block of information.
I am not familiar with VBA and its going way over my head.
Thanks in advance, Eskimo
Here is the code...
Sub ConvertFile()
Dim LCStart As Long
Dim IQStart As Long
Dim Lat1Start As Long
Dim Lon1Start As Long
Dim Lat2Start As Long
Dim Lon2Start As Long
Dim NbmesStart As Long
Dim Nbmes2Start As Long
Dim BestLevelStart As Long
Dim PassDurStart As Long
Dim NOPCStart As Long
Dim CalcFreqStart As Long
Dim AltStart As Long
Dim Num1Start As Long
Dim Num2Start As Long
Dim Num3Start As Long
Dim Num4Start As Long
Dim LineIn As String
Dim RecNo As Long
Dim RecLine As Long
Dim aryData As Variant
Dim maxRecords As Long
Dim recColumns As Long
maxRecords = 17000
recColumns = 20
Worksheets("Raw Data").UsedRange.Offset(1, 0).Resize(maxRecords,
recColumns).EntireRow.Delete
aryData = Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords,
recColumns)
ChDrive Left(ActiveWorkbook.Path, 1)
ChDir ActiveWorkbook.Path
'FName = Range("FName").Value
Open Range("FName") For Input As #1
RecNo = 2
RecLine = 0
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, LineIn ' Read line into variable.
RecLine = RecLine + 1
Select Case RecLine
Case 1
LCStart = WorksheetFunction.Find("LC :", LineIn)
IQStart = WorksheetFunction.Find("IQ :", LineIn)
aryData(RecNo, 1) = Mid(LineIn, 2, 5)
aryData(RecNo, 2) = WorksheetFunction.Substitute(Mid(LineIn, 15, 8),
".", "/")
aryData(RecNo, 3) = TimeValue(Mid(LineIn, 24, 8))
aryData(RecNo, 4) = Trim(Mid(LineIn, LCStart + 4, IQStart - (LCStart
+ 4)))
aryData(RecNo, 5) = Trim(Mid(LineIn, IQStart + 4))
Case 2
Lat1Start = WorksheetFunction.Find("Lat1 :", LineIn)
Lat2Start = WorksheetFunction.Find("Lat2 :", LineIn)
Lon1Start = WorksheetFunction.Find("Lon1 :", LineIn)
Lon2Start = WorksheetFunction.Find("Lon2 :", LineIn)
aryData(RecNo, 6) = Trim(Mid(LineIn, Lat1Start + 6, Lon1Start -
(Lat1Start + 6)))
aryData(RecNo, 7) = Trim(Mid(LineIn, Lon1Start + 6, Lat2Start -
(Lon1Start + 6)))
aryData(RecNo, 8) = Trim(Mid(LineIn, Lat2Start + 6, Lon2Start -
(Lat2Start + 6)))
aryData(RecNo, 9) = Trim(Mid(LineIn, Lon2Start + 6))
Case 3
NbmesStart = WorksheetFunction.Find("Nb mes :", LineIn)
Nbmes2Start = WorksheetFunction.Find("Nb mes>-120dB :", LineIn)
BestLevelStart = WorksheetFunction.Find("Best level :", LineIn)
aryData(RecNo, 10) = Trim(Mid(LineIn, NbmesStart + 8, Nbmes2Start -
(NbmesStart + 8)))
aryData(RecNo, 11) = Trim(Mid(LineIn, Nbmes2Start + 15,
BestLevelStart - (Nbmes2Start + 15)))
aryData(RecNo, 12) = Trim(Mid(LineIn, BestLevelStart + 12))
Case 4
PassDurStart = WorksheetFunction.Find("Pass duration :", LineIn)
NOPCStart = WorksheetFunction.Find("NOPC :", LineIn)
aryData(RecNo, 13) = Trim(Mid(LineIn, PassDurStart + 15, NOPCStart -
(PassDurStart + 15)))
aryData(RecNo, 14) = Trim(Mid(LineIn, NOPCStart + 6))
Case 5
CalcFreqStart = WorksheetFunction.Find("Calcul freq :", LineIn)
AltStart = WorksheetFunction.Find("Altitude :", LineIn)
aryData(RecNo, 15) = Trim(Mid(LineIn, CalcFreqStart + 13, AltStart -
(CalcFreqStart + 13)))
aryData(RecNo, 16) = Trim(Mid(LineIn, AltStart + 10))
Case 6
Num1Start = WorksheetFunction.Find(" ", LineIn, 2)
Num2Start = WorksheetFunction.Find(" ", LineIn, Num1Start + 1)
Num3Start = WorksheetFunction.Find(" ", LineIn, Num2Start + 1)
Num4Start = WorksheetFunction.Find(" ", LineIn, Num3Start + 1)
aryData(RecNo, 17) = Trim(Mid(LineIn, Num1Start + 1, Num2Start -
(Num1Start + 1)))
aryData(RecNo, 18) = Trim(Mid(LineIn, Num2Start + 1, Num3Start -
(Num2Start + 1)))
aryData(RecNo, 19) = Trim(Mid(LineIn, Num3Start + 1, Num4Start -
(Num3Start + 1)))
aryData(RecNo, 20) = Trim(Mid(LineIn, Num4Start + 1))
Case Else
If LineIn = " " Then
RecLine = 0
RecNo = RecNo + 1
Else
MsgBox "Record number " & RecNo & " (collar number " &
aryData(RecNo, 1) & _
")" & Chr(10) & "has this additional line:" & _
Chr(10) & Chr(10) & LineIn, vbInformation, "Please note"
End If
End Select
Loop
Close
Worksheets("Raw Data").UsedRange.Offset(0, 0).Resize(maxRecords, recColumns)
= aryData
Worksheets("Raw Data").UsedRange.Offset(RecNo, 0).Resize(maxRecords + 1 -
RecNo).EntireRow.Delete
End Sub
Here below is the way it use to be...note the space in the empty line
between each block.
06979 Date : 26.11.04 13:18:02 LC : 0 IQ : 40
Lat1 : 65.607N Lon1 : 103.130W Lat2 : 66.861N Lon2 : 110.355W
Nb mes : 006 Nb mes>-120dB : 000 Best level : -132 dB
Pass duration : 483s NOPC : 2
Calcul freq : 401 649301.8 Hz Altitude : 144 m
00 2991 00 11
06979 Date : 26.11.04 14:09:13 LC : B IQ : 00
Lat1 : 65.503N Lon1 : 103.237W Lat2 : 54.304N Lon2 : 41.614W
Nb mes : 002 Nb mes>-120dB : 000 Best level : -133 dB
Pass duration : 138s NOPC : 2
Calcul freq : 401 649301.8 Hz Altitude : 0 m
00 2465 00 11
06979 Date : 26.11.04 14:09:48 LC : 0 IQ : 46
Lat1 : 65.586N Lon1 : 102.939W Lat2 : 64.211N Lon2 : 95.011W
Nb mes : 007 Nb mes>-120dB : 000 Best level : -130 dB
Pass duration : 483s NOPC : 2
Calcul freq : 401 649352.1 Hz Altitude : 134 m
00 2352 00 11
Here below is how the emails are now. note the lack of an empty line
between each blcok
as compared with that above.
06976 Date : 03.03.05 13:28:16 LC : 0 IQ : 50
Lat1 : 65.285N Lon1 : 100.524W Lat2 : 68.146N Lon2 : 115.915W
Nb mes : 004 Nb mes>-120dB : 000 Best level : -129 dB
Pass duration : 462s NOPC : 2
Calcul freq : 401 651572.3 Hz Altitude : 138 m
00 70 00 235
06976 Date : 03.03.05 14:12:16 LC : Z IQ : 00
Lat1 : ??????? Lon1 : ???????? Lat2 : ??????? Lon2 : ????????
Nb mes : 009 Nb mes>-120dB : 000 Best level : -128 dB
Pass duration : 594s NOPC : 0
Calcul freq : 401 650000.0 Hz Altitude : 0 m
00 54 55 235
06976 Date : 03.03.05 14:26:34 LC : 0 IQ : 53
Lat1 : 65.317N Lon1 : 100.425W Lat2 : 82.934N Lon2 : 141.492E
Nb mes : 006 Nb mes>-120dB : 000 Best level : -130 dB
Pass duration : 594s NOPC : 3
Calcul freq : 401 651187.5 Hz Altitude : 137 m
00 52 02 235
Any suggestions?
Eskimo