Re: 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 <scottsincl...@xxxxxxxxxxxxx> 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 Work***)
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(Active***)

With Active***.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 Active***.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 <barna...@xxxxxxxxxxxxxxxxxxxxxxxxx>
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 <barna...@xxxxxxxxxxxxxxxxxxxxxxxxx>
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
"active***.usedrange.row+active***.usedrange.rows.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(active***)
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
work*** (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 work*** to display the
date of the work*** - 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/microsoft.public.excel.programming/b...

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

Thanks in advance,
Scott.




.

Loading