The Ultimate Problem

[Guest]

Hi.

I have a big problem and this might be a bridge too far for those that have
always come to my aid in the past.

The problem. I have @5000 Excel files that hold product details in a folder
called FILES. Each file is randomly titled. Each file is has been created
from a base template so they are all identical in format but different in
content. Each product is identified by a product number. However the product
number shares a cell with random text. eg. Green bananas pn 3378 and yellow
bananas pn 7765. What I need to do is run some excel code that will open each
file, jump to the target cell, identify the number string, extract it, and
then save the file using that number string. So, the file curently called '58
Green Ban' will be opened, 3378 extracted from within a text string and then
that file saved with the name 3378.

This is big and hairy and anyone who can do this should win the nobel excel
prize for being obsenely brainy.

Thanks in advance.

Gordon.

 

[Harald Staff]

Hi Gordon

Here's code that opens all files in a folder:
http://www.contextures.com/xlfaqMac.html#LoopBooks

Combine a modified version of it with code that reads a cell value, like

Dim S As String
S = wb.Sheets(1).Range("B14").Value

and code that saves the workbook as that (you figure that out yourself, hint
Macro recorder -and you've earned yourself your very own nobel prize.

HTH. Best wishes Harald

 

[Otto Moehrbach]

Gordon
This might work for you. I assumed that the folder FILES was under the
root folder (C:\FILES). I also assumed that you wanted the old files
removed from the hard drive. HTH Otto
Sub AllFolderFiles()
Dim wb As Workbook
Dim TheFile As String
Dim MyPath As String
Dim NewName As String
MyPath = "C:\FILES"
ChDir MyPath
TheFile = Dir("*.xls")
Application.ScreenUpdating = False
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
wb.Activate
NewName = Right(Sheets("Sheet1").Range("A1"), 4)
wb.SaveAs wb.Path & "\" & NewName & ".xls"
Application.DisplayAlerts = False
wb.Close
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
wb.Activate
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close
Application.DisplayAlerts = True
TheFile = Dir
Loop
Application.ScreenUpdating = True
End Sub