A Dave Peterson macro

S

SteveDB1

Morning all.
Back on Tax day, Dave P posted a response to an individual named
"ucanalways" regarding their request to search for specific files.
The code that Dave posted is:
----------------------------------------------------
Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim TempWkbk as Workbook

'use whatever you know to get the folder
myPath = "C:\my documents\excel\test\"
If myPath = "" Then Exit Sub
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
If LCase(myFile) Like LCase("1_*.xls") Then
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
End If
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Set TempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))
'do some stuff
TempWkbk.Close savechanges:=False 'or True
Next fCtr
End If

End Sub
----------------------------------------------------------------
As I studied this code, I found that it would work for my purposes-- with a
couple of changes in the myPath, Lcase, and more near the end: specifically
within this loop-
---------------------------
If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Set TempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))
'do some stuff
TempWkbk.Close savechanges:=False 'or True
Next fCtr
End If
-----------------------------------
However, with my addition, I found that it does not work, and so I'm back to
see what I'd need to accomplish my goals. I added a "Dim FSO as object" in my
variable declarations.
Here is what I placed within that loop:
=======================
If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)

Set TempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

'{ start of my addition/change

'This will be an attempt to look at comparing files.
'If it does not work, remove the code from this location.
'Call ASaveNewFormat
'myFile = Left(myFile, InStr(myFile, ".") - 1)
'this removes the existing file's extension

If FSO.FileExists(myPath & "PostRun\" & myFile & ".xlsx") = True
Then

'this is part of Ron DB's modification to compare files.
'final directory- directory B

MsgBox "The file: " & myFile & " has been processed."

'} end of my addition

End If

' this message box is here to let me know this macro is
working....
MsgBox "this is a placeholder for another macro to perform some
set of tasks."

'do some stuff

TempWkbk.Close savechanges:=False 'or True;
'this throws an error because of the workbook.close in the
'ASaveNewFormat code. Comment the TempWkBk.close.... when
'ASaveNewFormat is active.
'if you comment ASaveNewFormat, make sure you uncomment this
'message box.
' And Vice Versa.

Next fCtr
End If
=======================
In my code additon, I want to look at the file name stored in myFile, and
compare it to a file in the secondary directory. If they have an identical
name-- without the file extension-- I want to state in a message box that the
file has already been worked on, and is complete-- hence MsgBox "The File: "
& myFile & "has already been processed."
I then want to move on to the next file, and check it against the list in
the secondary directory.
However, in doing that, as this is presently written, I have found that
1- an error is thrown because myFile still has the previous file name stored
in it, and does not recognize the new file name.
a- this is now making me think I need a secondary if-else loop within
the primary if-else fCtr loop to make it work. I.e., a secondary counter to
iterate through each file name.
2- when I comment my additional elements, to examine it further, it then
calls to a completely different macro (actually, it's a UDF), inside my xlam
file, and I can find no link to that macro, or my xlam file. (The code for
the above copied DaveP testme1 macro is in my xlsb file, which I use as a
testing ground before I move things over to my xlam file.) This completely
threw me, as there are no links to this other macro/UDF.
a- how can I prevent that from happening?

3- I keep thinking there is something else I need to say here, but I can't
think of it at the moment. I hate that!
 
D

Dave Peterson

I'd do the narrowing down part when I was accumulating names. (Six of one.
Half dozen of the other!)

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim myProcessedPath As String
Dim myFileNoExt As String
Dim FSO As Object
Dim AlreadyProcessed As Boolean
Dim TempWkbk As Workbook

'use whatever you know to get the folder
myPath = "C:\my documents\excel\test\"
If myPath = "" Then Exit Sub
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myProcessedPath = myPath & "postrun"
If myProcessedPath = "" Then Exit Sub
If Right(myProcessedPath, 1) <> "\" Then
myProcessedPath = myProcessedPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Set FSO = CreateObject("Scripting.FileSystemObject")

'get the list of files
fCtr = 0
Do While myFile <> ""
If LCase(myFile) Like LCase("1_*.xls") Then
myFileNoExt = Left(myFile, InStrRev(myFile, ".") - 1)

AlreadyProcessed _
= FSO.fileexists(myProcessedPath & myFileNoExt & ".xlsx")

If AlreadyProcessed = True Then
MsgBox "The File: " & myFileNoExt _
& " has already been processed."
Else
'not there, so include that file
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
End If
End If
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Set TempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))
'do some stuff
TempWkbk.Close savechanges:=False 'or True
Next fCtr
End If

End Sub
 
S

SteveDB1

Dave,
Ka-Ching!!!!
Thank you.
It works excellently.

I see you chose to place my comparison in the do-while loop.
I had thought it should've either gone between the do-while, and the fCtr
loop, or within the fCtr loop itself, as a secondary counter to do the
comparison, because it seemed that the do-while was populating the myFile()
element.

This is perfect for our need.
Thanks again.
 
D

Dave Peterson

I was already limiting the myfiles() array. So why not just add another
limitation???

Glad it worked ok for you.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top