I am trying to search all subfolders for a file to eliminate possible duplicate file names. Any help would be appreciated.
[code]
Sub UPDATE()
Application.EnableCancelKey = xlInterrupt
On Error GoTo ENDTHISSUB
RNC = 2
Sheets("G-DRIVE").Select
Do While Cells(RNC, 2) <> ""
GoSub MOVEGDRIVE
RNC = RNC + 1
MSGC = MsgBox("CONTINUE?", vbYesNo)
If MSGC = vbNo Then Exit Do
Loop
GoTo ENDTHISSUB
MOVEGDRIVE:
MSGF = vbYes
GoSub MOVEFILE
If MSGF = vbNo Then Return
Cells(RNC, 3).Select
Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
Selection.Copy
Sheets("INVAULT").Select
RNP = Cells(1, 5)
Cells(RNP, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
RNP = RNP + 1
Cells(1, 5) = RNP
Sheets("G-DRIVE").Select
Range(Cells(RNC, 1), ActiveCell.Offset(0, 24)).Select
Selection.Delete Shift:=xlUp
RNC = RNC - 1
Return
MOVEFILE:
FCS$ = Cells(RNC, 15) & Cells(RNC, 17)
FPS$ = Cells(RNC, 16) & Cells(RNC, 17)
FTS$ = "C\USERS\" & Cells(1, 19) & "\DOCUMENTS\VAULT\PROJECTS\*" & Cells(RNC, 17) & "/S"
Do While Dir(FTS$) <> ""
MSGF = MsgBox("filename " + FPS$ + " exists.Rename?", vbYesNo)
If MSGF = vbYes Then FPS$ = FPS$ + "_1"
If MSGF = vbYes Then FTS$ = FTS$ + "_1"
If MSGF = vbNo Then MSG = MsgBox("Copy failed. Try again?", vbYesNo)
If MSGF = vbNo Then If MSG = vbNo Then MsgBox ("File Skipped")
If MSGF = vbNo Then If MSG = vbNo Then Return
Loop
FileCopy FCS$, FPS$
If Dir(FPS$) <> "" Then
MSGD = MsgBox("COPY SUCCESS! ERASE " + FCS$ + "?", vbYesNo)
If MSGD = vbYes Then Kill (FCS$)
End If
Return
ENDTHISSUB:
End Sub
[code]
Bookmarks