D
Debbie
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.
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.