Hello -

I have code that opens every file in a specified
folder, one by one, and retrieves the month and
the customer name from certain cells on the
active worksheet. It then uses the customer
name as criteria to determine if a folder for
that customer already exists, and if not, it
creates the folder/path for that customer.
The workbook then closes, and all files with
the same customer name are moved into that
customer's folder. This goes on until all
files in the specified folder have been
moved to their own respective folders.

All works exactly as intended until Excel
encounters a file with an apostrophe or a
pound sign (#) in the file name. The folder
for the customer is created without incident,
but when the workbook closes and Excel looks
for the files containing the customer name,
I get a "File Cannot Be Found" error. I've
finally figured out that it cannot find the
file because Excel drops the ".xls" extension,
and appends a numerical value to the file name.

I developed a "fix" for this, but since I do
not know what to do to prevent it (other than
the obvious - not to use apostrophes and pound
signs in the file name), I don't know what
kind of error-checking to do. For instance,
my "fix" involves looking for numbers at the
end of any file name that does not have an
".xls" extension, removing those numbers, and
appending the extension. However, I will have
files that end with numbers, so I can see a
potential problem if the customer name contains
one of the troublesome characters. And since
Excel appends the numbers according to the
order in which the file was opened (I think),
I cannot determine what the appended number
will be. I tried using code to count the
files (".FoundFiles.Count") in the specified
folder to get a maximum number that could be
appended, but I could not get the code to
work.

If you see a way to change the following code
to accommodate all files, or a way to prevent
Excel from changing the file name, I sure can
use the help.

Thanks,

Debbie



Sub MoveFilesToFinalLocation()
Dim FirstWorkbookOpened As Workbook
Dim SubsequentWorkbooksOpened As Workbook
Dim SourcePath As String
Dim DestinationPath As String
Dim JustTheFile As String
Dim i As Long
Dim j As Long
Dim NumberOfNumbers As Long
Dim CharactersToSubtract As Long


Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

With Application.FileSearch
.NewSearch
.LookIn = "C:\Insertion Orders"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set FirstWorkbookOpened = Workbooks.Open(.FoundFiles(1))

FirstWorkbookOpened.Activate
ActiveWorkbook.Sheets("OrderEntry").Activate

' This is where the info is pulled from the
' active sheet, and the check is performed
' as to whether or not a folder needs to be
' created for the customer.
Call CheckForOrCreateCustomerFolder

JustTheFile = FirstWorkbookOpened.Name

If Right(JustTheFile, 4) < ".xls" Then

For j = 1 To Len(JustTheFile)
NumberOfNumbers = 0
If IsNumeric(Mid(JustTheFile, j, 1)) Then
NumberOfNumbers = NumberOfNumbers + 1
End If
Next j

If NumberOfNumbers 0 Then
CharactersToSubtract = NumberOfNumbers
JustTheFile = Left(JustTheFile, Len(JustTheFile) - _
CharactersToSubtract)
End If

JustTheFile = JustTheFile & ".xls"

'MsgBox JustTheFile
End If

FirstWorkbookOpened.Close SaveChanges:=False

SourcePath = "C:\Insertion Orders\"
DestinationPath = PathName

Name SourcePath & JustTheFile As DestinationPath _
& JustTheFile

For i = 2 To .FoundFiles.Count
Set SubsequentWorkbooksOpened = Workbooks.Open(.FoundFiles(i))

SubsequentWorkbooksOpened.Activate
ActiveWorkbook.Sheets("OrderEntry").Activate
ActiveSheet.Range("A1").Select

Call CheckForOrCreateCustomerFolder

JustTheFile = SubsequentWorkbooksOpened.Name

If Right(JustTheFile, 4) < ".xls" Then

For j = 1 To Len(JustTheFile)
NumberOfNumbers = 0
If IsNumeric(Mid(JustTheFile, j, 1)) Then
NumberOfNumbers = NumberOfNumbers + 1
End If
Next j

If NumberOfNumbers 0 Then
CharactersToSubtract = NumberOfNumbers
JustTheFile = Left(JustTheFile, Len(JustTheFile) - _
CharactersToSubtract)
End If

JustTheFile = JustTheFile & ".xls"

'MsgBox JustTheFile
End If

SubsequentWorkbooksOpened.Close SaveChanges:=False

SourcePath = "C:\Insertion Orders\"
DestinationPath = PathName

Name SourcePath & JustTheFile As DestinationPath & _
JustTheFile

Next i
Else
Exit Sub
End If
End With

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


P.S. - I tried telling Excel to replace the
apostrophe with double apostrophes (''), and
to replace the pound sign with some other
character temporarily, but that made no
difference.