Extract data question

[Guest]

Hello,

I am completely new to VBA so I hope you will bear with me...
My problem is that I need to extract certain data is always in the same
format, ie

[STATION NUMBER]
12005
[END]
[CDS Details]
NAME,MUICK
LOCATION,INVERMUICK
NOMINAL AREA, 110.00
NOMINAL NGR,336400,794700
[End]

where I need to extract the 2nd and 8th lines, and place them in adjacent
colums in an excel file, then go to the next file down (named numerically)

Many many thanks for any help - I have about 1000 files to go through!

Nick

 

[Tom Ogilvy]

If the files were file1.txt to file1000.txt found in the C:\ directory:

Sub ABC()
Dim sh As Worksheet
Dim bk As Workbook
Dim i As Long
Set sh = ActiveSheet
For i = 1 To 1000
Set bk = Workbooks.Open("c:\file" & i & ".txt")
sh.Cells(i, 1) = bk.Worksheets(1).Cells(2, 1)
sh.Cells(i, 2) = bk.Worksheets(1).Cells(8, 1)
bk.Close Savechanges:=False
Next
End Sub

 

[William Benson]

I would put them all in a folder and run the code below.

Note: I have assumed you will name the folder MyFiles and store it on C
Only the text files should be in that folder

Private Sub LoadValuesFromTextFiles()
Dim FSO, FLD, FIL
Dim N As Long, i As Long
Dim S As String
Dim LineCount As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder("C:\MyFiles")

'Assign the next free file to N
N = FreeFile()

Application.ScreenUpdating = False
For Each FIL In FLD.Files
'Open Text File For Input
Open FIL.Path For Input As #N
'Loop Until the either End Of File or row 9
While Not EOF(N) And LineCount < 8
LineCount = LineCount + 1
Line Input #N, S
If LineCount = 2 Or LineCount = 8 Then
If Left(S, 1) = "=" Then S = "'" & S
ActiveCell.Offset(i, 0).Value = S
i = i + 1
End If
Wend 'Not EOF(N) And LineCount < 8
LineCount = 0
Close #N
Next FIL
Application.ScreenUpdating = True

End Sub