Ah, yes it DOES work! The problem was that I had headings already in
for the columns (which I need, incidentally). Other than that, all is
good - but I now have a problem with it stripping the leading zero
from the date...

But you're doing great stuff here. Thanks for this!

Scott.

(oh, and if someone sees a duplicate comment by me on another post,
it's because I just replied to this post in the wrong window. D'oh!)

On Aug 28, 5:09 pm, "Ron de Bruin" wrote:
Strange

Can you send me one of the txt files private so I can test it

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"scott" wrote in oglegroups.com...

Hi Ron,
No errors - but nothing gets imported, either (it goes through the
file import process ok, and then pauses - as if it's importing - but
then just a blank sheet). If I go back to the original code posted by
yourself (before the mod for the date column) it works ok, however.

Thanks for bearing with me.

Scott.

On Aug 28, 4:33 pm, "Ron de Bruin" wrote:

No errors ?

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"scott" wrote in ooglegroups.com...
Hi Ron,
Unfortunately still no luck.

Scott.

Ron de Bruin wrote:
Remove this line

On Error GoTo CleanUp

And debug

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"scott" wrote in ooglegroups.com...
Ron,
For some reason nothing. No error, but nothing is imported either.

Scott.

Ron de Bruin wrote:
Tru this sub then

Sub Get_TXT_Files_Test()
'For Excel 2000 and higher
Dim Fnum As Long
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
Dim I As Long

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet(Application.DefaultFilePath)
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

If IsArray(TxtFileNames) Then

On Error GoTo CleanUp

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

I = LastRow(ActiveSheet)

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1

'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited

'Set your Delimiter to true
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False

'Set the format for each column if you want (Default = General)
'For example Array(1, 9, 1) to skip the second column
.TextFileColumnDataTypes = Array(1, 9, 1)

'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9

' Get the data from the txt file
.Refresh BackgroundQuery:=False

End With
Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _
Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6)

Next Fnum

CleanUp:
For Each QTable In ActiveSheet.QueryTables
QTable.Delete
Next

ChDirNet SaveDriveDir

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"scott" wrote in oglegroups.com...
Hi Ron,
Yes, there are always the 2 characters. They vary from either B1 or
B2, but always follow the same format.

Thanks in advance,
Scott.

Ron de Bruin wrote:
Hi Scott

B1020607.txt

Are there always two characters (B1 in this file name) before the date

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"scott" wrote in oglegroups.com...
Hi Ron,
This works excellent, thankyou.

One thing I didn't realise before though...The date isn't actually in
the text file anywhere (which is useless). Is there a way we can
extract the date from the name of the text file (i.e. B1020607.txt)
and insert this into column 1 in the relevant places?

Sorry if this is too much work - I'm pulling my hair out.

Thanks in advance,
Scott.
(Note: I'll post this as a seperate in the same group as it kind of
goes off on a tangent from this point).
Ron de Bruin wrote:
Hi Scott

Test this one
Copy all the code in a normal module of your workbook
It will copy the data in the activesheet

For all files in a folder check out also this page
http://www.rondebruin.nl/csv.htm

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn < 0)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub Get_TXT_Files()
'For Excel 2000 and higher
Dim Fnum As Long
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
Dim I As Long

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet(Application.DefaultFilePath)
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

If IsArray(TxtFileNames) Then

On Error GoTo CleanUp

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

I = LastRow(ActiveSheet)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1

'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited

'Set your Delimiter to true
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True

...

read more »