Sub "Fill cells using file name" ()

[Karthik Bhat - Bangalore]

Hi

I have a set of excel files (about 100) stored in a specified folder
(say "c:\temp"). All the file names have two parts; the first part
is name of a person and seconds his location, separated by a
'space'. Example (David Paris.xls, Tim NY.xls ... etc) and all
files have similar structure.

What I want is a code that will open each of these files go to a
worksheet named 'ledger' and put the name of the person in cell A1
and location in Cell A2 (both from file name).The code should do this
until it finishes all the files in the folder.

Thanks for taking time to help me

Karthik Bhat
Bangalore

 

[Guest]

Option Explicit

Sub UpdateFiles()

Dim fn As String
Dim wb As Workbook
Dim ws As Worksheet
Dim pos As String
Dim text As String
fn = Dir("C:\temp\*.xls")

Do Until fn = ""

Set wb = Workbooks.Open("C:\temp\" & fn)
Set ws = wb.Worksheets("ledger")
pos = InStr(fn & " xxx", " ")
ws.Range("A1") = Left(fn, pos - 1)
text = Mid("abwkfhl" & fn, pos + 1)
text = Left(text, Len(text) - 4) 'strip off th e.XLS
ws.Range("A2") = Mid(fn, pos + 1)
wb.Close True
fn = Dir()
Loop


End Sub

 

[Guest]

whoops. I sent the wrong one earlier...this is correct...sorry

Option Explicit

Sub UpdateFiles()

Dim fn As String
Dim wb As Workbook
Dim ws As Worksheet
Dim pos As String
Dim text As String
fn = Dir("C:\temp\*.xls")

Do Until fn = ""

Set wb = Workbooks.Open("C:\temp\" & fn)
Set ws = wb.Worksheets("ledger")
pos = InStr(fn, " ")
ws.Range("A1") = Left(fn, pos - 1)
text = Mid(fn, pos + 1)
text = Left(text, Len(text) - 4) 'strip off the .XLS
ws.Range("A2") = Mid(fn, pos + 1)
wb.Close True
fn = Dir()
Loop


End Sub

 

[KL]

Hi,

You may try this code (I haven't tested it though). The function split will
fail in XL97 and below.

Sub ListFiles()
Dim Ruta As String, x As Integer, n As Variant
Ruta = "C:\temp\"
Set fs = Application.FileSearch
Application.ScreenUpdating = False
On Error Resume Next
With fs
.LookIn = Ruta
.SearchSubFolders = False
.Filetype = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
n = Split(Trim(Replace(Dir(.FoundFiles(i)), ".xls", "")), "
")
ActiveWorkbook.Sheets("ledger").Range("A1:A2").Value = _
WorksheetFunction.Transpose(n)
Next i
End If
End With
Application.ScreenUpdating = True
End Sub

Regards,
KL

 

[Karthik Bhat - Bangalore]

Hi Patrick

Thanks a lot for the code... it works very well.. I did not change
anything in the code and it was just a Ctrl C and a Ctrl V that I had
to do.

Thanks a lot once again..

Karthik Bhat
Bangalore