Excel 2007
 

In using Excle 2007, I am asked to convert to a new file format. for the
most part I have complied since is a requirement at work. In doing so I
have duplicated my files. I have identical files one with xls (older
version) and the new sxls extension. Now does any one know a macro (?)
that deletes the older version files only if there is one with the same
title but different extension?




--
ab3d4u

Excel 2007
 

This will work on a single folder. It looks kind of complicated, but
that's because it sends the files to the recycling bin so you can
review before complete deletion. I opted to use that instead of
checking file date, etc, which are unreliable means of determining
whether a file deserves deletion. I didn't bother doing any kind of
browse folder functionality.

Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Const FO_DELETE = &H3
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40

Private Declare Function SHFileOperation _
Lib "shell32.dll" Alias "SHFileOperationA" _
(ByRef lpFileOp As SHFILEOPSTRUCT) As Long

Sub Recycle(ByVal fileName As String)

Dim uFileOperation As SHFILEOPSTRUCT
Dim lReturn As Long

'Fill the UDT with information about what to do
With uFileOperation
.wFunc = FO_DELETE
.pFrom = fileName
.pTo = vbNullChar
.fFlags = _
FOF_SILENT + FOF_NOCONFIRMATION + FOF_ALLOWUNDO
End With

'Pass the UDT to the function
lReturn = SHFileOperation(uFileOperation)

If lReturn < 0 Then
Err.Raise vbObjectError + 1, "Error deleting file."
End If
End Sub


Public Sub deleteExcel2003files()
Dim path As String

Dim fileName As String
Dim fileCount As Long
Dim rngMatch As Excel.Range
Dim i As Long
Dim wsh As Excel.Worksheet

path = Application.InputBox("Enter folder path: ")

If (Right$(path, 1) < "\") Then
path = path & "\"
End If

Set wsh = ThisWorkbook.Worksheets.Add
On Error Resume Next
wsh.Name = "OldFiles"
If Err.Number < 0 Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("OldFiles").Delete
Application.DisplayAlerts = True
wsh.Name = "OldFiles"
End If
On Error GoTo 0

fileName = Dir(path & "*.xls*", vbNormal)
fileCount = 0

With wsh
While Len(fileName)
fileCount = fileCount + 1
.Cells(fileCount, 1).Value = fileName
If Len(fileName) - InStrRev(fileName, ".") = 4 Then
.Cells(fileCount, 2).Value = _
Left$(fileName, Len(fileName) - 1)
End If
fileName = Dir()
Wend

If fileCount < 1 Then
Call MsgBox("No files found!")
Exit Sub
End If

For i = 1 To fileCount
If Len(.Cells(i, 2).Value) Then
Set rngMatch = .Range("$A1:$A" & _
fileCount).Find(.Cells(i, 2).Value)
If Not (rngMatch Is Nothing) Then
Recycle (path & .Cells(i, 2).Value)
End If
End If
Next i
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub

Excel 2007
 

P.S. The Recycling Bin code is by Bullen/Bovey.

On Dec 1, 6:46 pm, ilia wrote:
This will work on a single folder. It looks kind of complicated, but
that's because it sends the files to the recycling bin so you can
review before complete deletion. I opted to use that instead of
checking file date, etc, which are unreliable means of determining
whether a file deserves deletion. I didn't bother doing any kind of
browse folder functionality.

Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Const FO_DELETE = &H3
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40

Private Declare Function SHFileOperation _
Lib "shell32.dll" Alias "SHFileOperationA" _
(ByRef lpFileOp As SHFILEOPSTRUCT) As Long

Sub Recycle(ByVal fileName As String)

Dim uFileOperation As SHFILEOPSTRUCT
Dim lReturn As Long

'Fill the UDT with information about what to do
With uFileOperation
.wFunc = FO_DELETE
.pFrom = fileName
.pTo = vbNullChar
.fFlags = _
FOF_SILENT + FOF_NOCONFIRMATION + FOF_ALLOWUNDO
End With

'Pass the UDT to the function
lReturn = SHFileOperation(uFileOperation)

If lReturn < 0 Then
Err.Raise vbObjectError + 1, "Error deleting file."
End If
End Sub

Public Sub deleteExcel2003files()
Dim path As String

Dim fileName As String
Dim fileCount As Long
Dim rngMatch As Excel.Range
Dim i As Long
Dim wsh As Excel.Worksheet

path = Application.InputBox("Enter folder path: ")

If (Right$(path, 1) < "\") Then
path = path & "\"
End If

Set wsh = ThisWorkbook.Worksheets.Add
On Error Resume Next
wsh.Name = "OldFiles"
If Err.Number < 0 Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("OldFiles").Delete
Application.DisplayAlerts = True
wsh.Name = "OldFiles"
End If
On Error GoTo 0

fileName = Dir(path & "*.xls*", vbNormal)
fileCount = 0

With wsh
While Len(fileName)
fileCount = fileCount + 1
.Cells(fileCount, 1).Value = fileName
If Len(fileName) - InStrRev(fileName, ".") = 4 Then
.Cells(fileCount, 2).Value = _
Left$(fileName, Len(fileName) - 1)
End If
fileName = Dir()
Wend

If fileCount < 1 Then
Call MsgBox("No files found!")
Exit Sub
End If

For i = 1 To fileCount
If Len(.Cells(i, 2).Value) Then
Set rngMatch = .Range("$A1:$A" & _
fileCount).Find(.Cells(i, 2).Value)
If Not (rngMatch Is Nothing) Then
Recycle (path & .Cells(i, 2).Value)
End If
End If
Next i
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub