Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Pasting a chart from Excel 2007 to Word 2007 trouble | Charts and Charting in Excel | |||
import excel 2007 in outlook 2007 | Excel Discussion (Misc queries) | |||
How can you "save as" in excel 2007 (and word 2007)? | Excel Discussion (Misc queries) | |||
Exporting Quickbooks 2007 to Excel 2007 | Excel Worksheet Functions | |||
Problems with my links to an excel 2007 file from a word 2007 file | Links and Linking in Excel |