Generating a column based on import file name
 

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic...339530d?hl=en&

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic...339530d?hl=en&

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic...339530d?hl=en&

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:

Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic...339530d?hl=en&

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

Add this line before you set the value:
cells(l,1).numberformat="@"

"scott" wrote:

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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

Hi Barnabel,
I'm not really sure where to put this. I've tried but it's making
that whole column blank (no error).

The script I'm now using is below...

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_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 = False
.TextFileCommaDelimiter = True
.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(4, 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).NumberFormat = "@"
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





On Aug 28, 8:28 pm, barnabel
wrote:
Add this line before you set the value:
cells(l,1).numberformat="@"

"scott" wrote:
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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

Actually scrub that, small error on my part. It works now as plain
text - so my problem now is converting a 6 digit plain text string (eg
010807) into a usable date - something excel seems to disagree with me
on (it keeps coming up with v. strange dates for some reason!).

Thanks enormously,
Scott.

On Aug 28, 10:16 pm, scott wrote:
Hi Barnabel,
I'm not really sure where to put this. I've tried but it's making
that whole column blank (no error).

The script I'm now using is below...

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_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 = False
.TextFileCommaDelimiter = True
.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(4, 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).NumberFormat = "@"
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

On Aug 28, 8:28 pm, barnabel
wrote:

Add this line before you set the value:
cells(l,1).numberformat="@"

"scott" wrote:
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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

A couple little changes then...

"scott" wrote:

Actually scrub that, small error on my part. It works now as plain
text - so my problem now is converting a 6 digit plain text string (eg
010807) into a usable date - something excel seems to disagree with me
on (it keeps coming up with v. strange dates for some reason!).

Thanks enormously,
Scott.

On Aug 28, 10:16 pm, scott wrote:
Hi Barnabel,
I'm not really sure where to put this. I've tried but it's making
that whole column blank (no error).

The script I'm now using is below...

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_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
dim dateVal 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 = False
.TextFileCommaDelimiter = True
.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(4, 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

' set the format to a date rather than text
Cells(I, 1).NumberFormat = "m/d/yy"
' get the date from the file name
dateVal = clong(Mid(TxtFileNames(Fnum),
InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6))
' convert the date to a dateserial. Assumes no dates prior to 2000 and in
the format mmddyy
Cells(I + 1, 1) = dateserial((dateVal mod 100)+2000,
dateVal/10000,(dateVal/100) mod 100)

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

On Aug 28, 8:28 pm, barnabel
wrote:

Add this line before you set the value:
cells(l,1).numberformat="@"

"scott" wrote:
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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

Ooops I typed "clong" when I should have typed "clng" Bad fingers bad

"barnabel" wrote:

A couple little changes then...

"scott" wrote:

Actually scrub that, small error on my part. It works now as plain
text - so my problem now is converting a 6 digit plain text string (eg
010807) into a usable date - something excel seems to disagree with me
on (it keeps coming up with v. strange dates for some reason!).

Thanks enormously,
Scott.

On Aug 28, 10:16 pm, scott wrote:
Hi Barnabel,
I'm not really sure where to put this. I've tried but it's making
that whole column blank (no error).

The script I'm now using is below...

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_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
dim dateVal 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 = False
.TextFileCommaDelimiter = True
.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(4, 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

' set the format to a date rather than text
Cells(I, 1).NumberFormat = "m/d/yy"
' get the date from the file name
dateVal = clong(Mid(TxtFileNames(Fnum),
InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6))
' convert the date to a dateserial. Assumes no dates prior to 2000 and in
the format mmddyy
Cells(I + 1, 1) = dateserial((dateVal mod 100)+2000,
dateVal/10000,(dateVal/100) mod 100)

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

On Aug 28, 8:28 pm, barnabel
wrote:

Add this line before you set the value:
cells(l,1).numberformat="@"

"scott" wrote:
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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

It all seems to work perfect now. One small thing; my date format
(being in the UK) is d/m/yy as opposed to the format shown. Is this
easy to change?

And is it (easily) possible to make it import to row 2 and downwards
therefore preserving my column headings?

Thanks in advance,
Scott.

barnabel wrote:
Ooops I typed "clong" when I should have typed "clng" Bad fingers bad

"barnabel" wrote:

A couple little changes then...

"scott" wrote:

Actually scrub that, small error on my part. It works now as plain
text - so my problem now is converting a 6 digit plain text string (eg
010807) into a usable date - something excel seems to disagree with me
on (it keeps coming up with v. strange dates for some reason!).

Thanks enormously,
Scott.

On Aug 28, 10:16 pm, scott wrote:
Hi Barnabel,
I'm not really sure where to put this. I've tried but it's making
that whole column blank (no error).

The script I'm now using is below...

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_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
dim dateVal 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 = False
.TextFileCommaDelimiter = True
.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(4, 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

' set the format to a date rather than text
Cells(I, 1).NumberFormat = "m/d/yy"
' get the date from the file name
dateVal = clong(Mid(TxtFileNames(Fnum),
InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6))
' convert the date to a dateserial. Assumes no dates prior to 2000 and in
the format mmddyy
Cells(I + 1, 1) = dateserial((dateVal mod 100)+2000,
dateVal/10000,(dateVal/100) mod 100)

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

On Aug 28, 8:28 pm, barnabel
wrote:

Add this line before you set the value:
cells(l,1).numberformat="@"

"scott" wrote:
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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.

Generating a column based on import file name
 

I thought that might be the case but I wasn't sure.
Simply swap the second and third parameters to the dateserial function and
change the format string "d/m/yy" instead of "m/d/yy"

I'm not sure why your headers would not be preserved. The import starts at
Lastrow + 1 which should preserve them if they are already on the sheet.

I would still consider rewriting your LastRow function as:
Function LastRow(sh As Sheet) As Integer
' Note a totally blank sheet will still have the row=1 and count=1 so 1 row
is always used
LastRow = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
End Function

"scott" wrote:

It all seems to work perfect now. One small thing; my date format
(being in the UK) is d/m/yy as opposed to the format shown. Is this
easy to change?

And is it (easily) possible to make it import to row 2 and downwards
therefore preserving my column headings?

Thanks in advance,
Scott.

barnabel wrote:
Ooops I typed "clong" when I should have typed "clng" Bad fingers bad

"barnabel" wrote:

A couple little changes then...

"scott" wrote:

Actually scrub that, small error on my part. It works now as plain
text - so my problem now is converting a 6 digit plain text string (eg
010807) into a usable date - something excel seems to disagree with me
on (it keeps coming up with v. strange dates for some reason!).

Thanks enormously,
Scott.

On Aug 28, 10:16 pm, scott wrote:
Hi Barnabel,
I'm not really sure where to put this. I've tried but it's making
that whole column blank (no error).

The script I'm now using is below...

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_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
dim dateVal 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 = False
.TextFileCommaDelimiter = True
.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(4, 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

' set the format to a date rather than text
Cells(I, 1).NumberFormat = "m/d/yy"
' get the date from the file name
dateVal = clong(Mid(TxtFileNames(Fnum),
InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6))
' convert the date to a dateserial. Assumes no dates prior to 2000 and in
the format mmddyy
Cells(I + 1, 1) = dateserial((dateVal mod 100)+2000,
dateVal/10000,(dateVal/100) mod 100)

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

On Aug 28, 8:28 pm, barnabel
wrote:

Add this line before you set the value:
cells(l,1).numberformat="@"

"scott" wrote:
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.

On Aug 28, 3:44 pm, barnabel
wrote:
I didn't really look at your lastrow function. Is it possible that since the
imported data moved over to column B that function is not properly finding
last row?

I generally use the formula
"activesheet.usedrange.row+activesheet.usedrange.r ows.count-1" to find the
last row.

"scott" wrote:
Hi Barnabel,
Seems to not do anything - no errors but stops the files from
importing. Strange - I'm sure I'm putting it in the correct place.
Any ideas?

Scott.

barnabel wrote:
I would try the following:
1) change destination from cells(l+1,1) to cells(l+1,2)
This will shift the imported file over to make room for the new
information in Col A
2) after the "end with" add
dim newLast as long
newLast = LastRow(activesheet)
while l <= newLast
cells(l,1) = mid(TxtFileNames(Fnum),instrrev(TxtFileNames(Fnum) ,".")-6,6)
l=l+1
wend

"scott" wrote:

Hi all,
I have a macro which imports a selection of files to the active
worksheet (one after another). It does the job fine. The text files
are named as follows: B1020607.txt - where the last 6 digits are the
date of the file.

I need (somehow) for the first column in my worksheet to display the
date of the worksheet - to extract it somehow from the filename and
place it in the relevant places.

The macro to import the text files can be read at this location
(Thanks to Ron):
http://groups.google.co.uk/group/mic....programming/b...

If anyone can help with this problem it will be greatly appreciated.

Thanks in advance,
Scott.