Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Open endless number of file - Excel Automation

Status
Not open for further replies.

JAZPpl

Technical User
Oct 6, 2003
8
GB
Hello all,

I am trying to automate excel to open n number of file into a directory.
The target is to open all the *.txt file which are in a directory, then grab a couple of values and copy them into an output *.xls file then open the next *.txt file and son on.

The following sub does the job for one file only. What I need is to automate the procedure with a do loop. I have started it but I am struggling so need your help guys.

Thanks

francois

Sub LoadData()
Attribute LoadData.VB_Description = "Macro recorded 08/08/2004 by"
Attribute LoadData.VB_ProcData.VB_Invoke_Func = " \n14"
Dim filename1, WorkingPath As String

WorkingPath = ActiveWorkbook.PATH

With Application
.DefaultFilePath = WorkingPath

End With

ChDir WorkingPath

filename1 = Application.GetOpenFilename("Data File PRN Data(*.txt), *.txt")
Workbooks.OpenText Filename:=filename1, Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
ActiveWindow.WindowState = xlNormal
With ActiveWindow
.Top = 115.75
.Left = 253.75
End With
Range("A1:I8000").Select
Selection.Copy
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
Windows("LogFile.xls").Activate
Range("A1").Select
ActiveSheet.Paste
End Sub
 
Zathras,

Thanks, the code looks perfect for what I want to do but is there a way to avoid using the Const FILE_PATTERN = "ABC*.xls" and use any file with extension say *.txt within the working directory ?
Something like the following lines (I have copied this from a book)

Dim Fname as String
Dim Fnames() as String
Dim Ftype as String
Dim i as INteger

Ftype = "*.txt"
Fname = dir(Ftype)
Do until Fname = ""

i = i +1
ReDim Preserve Fnames (1 to i)
Fnames(i) = Fname
Fname = Dir
Loop


Thanks for commenting

Francois
 
Zathras,

I have amended your code however it will oven the file as an excel file but what I need to use is the Workbooks.OpenText structure instead of Workbooks.Open.
When doing so there is an error message.

So the code has changed and looks like:

Set WKB = Workbooks.OpenText(.FoundFiles(i))

TEe error is Expected Functions of Variable.

tHANKS FOR YOUR HELP

f,
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top