S
SteveDB1
Hi Ron,
Apparently my last post has been lost in the deep blue.....
Last week-- June 19-- we were discussing the modification of your Copy4
macro code to run through multiple workbooks, looking for a file name in a
primary directory, and then compare the file name to an identically named
file, with a different file extension, in a secondary directory.
The goal was to modify all of the macros that had not yet been modified, if
the file already existed in the secondary directory.
The last discussion we had was about one particular component of the Copy4
code, which did the comparison.
I've incorporated that code in to my macro, and have run through it multiple
times with a colleague to make it work for our purposes.
What I've found so far is that it looks at the files in dir A, and then
looks in dir B. But in looking at the files, it leaves the file extension
intact, thus looking at the whole file name.
The problem is that ifa file has laready been processed, it'll have a
different file extension. I.e., old- *.xls, new- *.xlsx.
Because it's not finding a *.xls in the secondary directory, it ignores the
new one, and processes the old file as if it were not previously processed.
I did try making a few modifications, such as using an extension-stripping
piece of code I obtained from Jim Thomlinson, but my use of it did not work
for this application. I know it was something I'd done wrong, and need to
resolve.
Below is my code, with comments.
'--------------------------------------------------------
Sub AFileSearch()
' this is a variation of Ron DeBruin's(DB) COPY4 macro presented on his
website.
Dim myPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim myBook As Workbook
Dim FSO As Object
myPath = "C:\StevesTemp\PreRun\" 'the path where source files located.
FilesInPath = Dir(myPath & "DTR*.xl*") 'files to look for.
If FilesInPath = "" Then
MsgBox "No Files Found" 'if no files are found, print msg box output.
Exit Sub 'if no files found, stop running macro.
End If
'tried ReDim preserve to files in path, but it has not worked, saying that I
'needed an array aspect which I could not clarify.
' This does not work the way I'd hoped.
'Remove, or change the way this is written so as to make something like it
actually work.
ReDim Preserve FilesInpath (1 to FNum) = ActiveWorkbook.Name 'this looks at
the existing file's name
'remove extension
FilesInPath = Left(FilesInPath, InStr(FilesInPath, ".") - 1) ' this appears
to remove the existing file's extension
Set FSO = CreateObject("scripting.filesystemobject") 'Apparently, this maps
my network drives.
'according to Ron DB, this will look forfiles with identical name. If it
does find them,
'it moves on, if it does not find identical file,
'it will save, and process a new file.
'this code, FSO, and the IF FSO changes this code from a purely run all
files, to a purely compare all files
'it opens the file, and tells the user if it already exists in the final
directory.
Fnum = 0 'this must remain zero. DO NOT CHANGE. If you change it, it will
throw all kinds of errors.
Do While FilesInPath <> "" 'will continue to process as long as FilesInPath
does not equal blank.
If FSO.FileExists("C:\StevesTemp\PreRun\PostRun\" & FilesInPath & ".xl*") =
True Then 'this is part of Ron DB's modification to compare files.
Fnum = Fnum + 1 'counter
ReDim Preserve MyFiles(1 To Fnum) 'part of counter.
MyFiles(Fnum) = FilesInPath
End If
FilesInPath = Dir()
Loop
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set myBook = Nothing
On Error Resume Next
Set myBook = Workbooks.Open(myPath & MyFiles(Fnum))
On Error GoTo 0
MsgBox "This file:" & MyFiles(Fnum) & "has been processed."
Next Fnum
Else
Call ASaveNewFormat 'this calls to a macro that will perform two
tasks.
'1st it will save the file as a new, xlsx format (which can be
modified),
'2nd it will remove all of the file's empty rows/columns.
End If
End Sub
'--------------------------------------------------------
Hopefully, this will actually post this time, because after 2 hours I still
can't find my original post.
Thanks again for your helps.
Apparently my last post has been lost in the deep blue.....
Last week-- June 19-- we were discussing the modification of your Copy4
macro code to run through multiple workbooks, looking for a file name in a
primary directory, and then compare the file name to an identically named
file, with a different file extension, in a secondary directory.
The goal was to modify all of the macros that had not yet been modified, if
the file already existed in the secondary directory.
The last discussion we had was about one particular component of the Copy4
code, which did the comparison.
I've incorporated that code in to my macro, and have run through it multiple
times with a colleague to make it work for our purposes.
What I've found so far is that it looks at the files in dir A, and then
looks in dir B. But in looking at the files, it leaves the file extension
intact, thus looking at the whole file name.
The problem is that ifa file has laready been processed, it'll have a
different file extension. I.e., old- *.xls, new- *.xlsx.
Because it's not finding a *.xls in the secondary directory, it ignores the
new one, and processes the old file as if it were not previously processed.
I did try making a few modifications, such as using an extension-stripping
piece of code I obtained from Jim Thomlinson, but my use of it did not work
for this application. I know it was something I'd done wrong, and need to
resolve.
Below is my code, with comments.
'--------------------------------------------------------
Sub AFileSearch()
' this is a variation of Ron DeBruin's(DB) COPY4 macro presented on his
website.
Dim myPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim myBook As Workbook
Dim FSO As Object
myPath = "C:\StevesTemp\PreRun\" 'the path where source files located.
FilesInPath = Dir(myPath & "DTR*.xl*") 'files to look for.
If FilesInPath = "" Then
MsgBox "No Files Found" 'if no files are found, print msg box output.
Exit Sub 'if no files found, stop running macro.
End If
'tried ReDim preserve to files in path, but it has not worked, saying that I
'needed an array aspect which I could not clarify.
' This does not work the way I'd hoped.
'Remove, or change the way this is written so as to make something like it
actually work.
ReDim Preserve FilesInpath (1 to FNum) = ActiveWorkbook.Name 'this looks at
the existing file's name
'remove extension
FilesInPath = Left(FilesInPath, InStr(FilesInPath, ".") - 1) ' this appears
to remove the existing file's extension
Set FSO = CreateObject("scripting.filesystemobject") 'Apparently, this maps
my network drives.
'according to Ron DB, this will look forfiles with identical name. If it
does find them,
'it moves on, if it does not find identical file,
'it will save, and process a new file.
'this code, FSO, and the IF FSO changes this code from a purely run all
files, to a purely compare all files
'it opens the file, and tells the user if it already exists in the final
directory.
Fnum = 0 'this must remain zero. DO NOT CHANGE. If you change it, it will
throw all kinds of errors.
Do While FilesInPath <> "" 'will continue to process as long as FilesInPath
does not equal blank.
If FSO.FileExists("C:\StevesTemp\PreRun\PostRun\" & FilesInPath & ".xl*") =
True Then 'this is part of Ron DB's modification to compare files.
Fnum = Fnum + 1 'counter
ReDim Preserve MyFiles(1 To Fnum) 'part of counter.
MyFiles(Fnum) = FilesInPath
End If
FilesInPath = Dir()
Loop
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set myBook = Nothing
On Error Resume Next
Set myBook = Workbooks.Open(myPath & MyFiles(Fnum))
On Error GoTo 0
MsgBox "This file:" & MyFiles(Fnum) & "has been processed."
Next Fnum
Else
Call ASaveNewFormat 'this calls to a macro that will perform two
tasks.
'1st it will save the file as a new, xlsx format (which can be
modified),
'2nd it will remove all of the file's empty rows/columns.
End If
End Sub
'--------------------------------------------------------
Hopefully, this will actually post this time, because after 2 hours I still
can't find my original post.
Thanks again for your helps.