Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Option Explicit Sub loopConvert() Dim fPath As String Dim fName As String, fSaveAsFilePath As String, fOriginalFilePath As String Dim wBook As Workbook, fFilesToProcess() As String Dim numconverted As Long, cntToConvert As Long, i As Long Dim killOnSave As Boolean, xMsg As Long, overWrite As Boolean, pOverWrite As Boolean Dim silentMode As Boolean Dim removeMacros As Boolean Dim fromFormat As String, toformat As String Dim saveFormat As Long Dim wkb As Workbook, wks As Worksheet Set wkb = ThisWorkbook Set wks = wkb.Sheets("Control Panel") removeMacros = IIf(wks.CheckBoxes("Check Box 1").Value = 1, True, False) silentMode = IIf(wks.CheckBoxes("Check Box 2").Value = 1, True, False) killOnSave = IIf(wks.CheckBoxes("Check Box 3").Value = 1, True, False) fromFormat = wkb.Names("fromFormat").RefersToRange toformat = wkb.Names("toFormat").RefersToRange saveFormat = IIf(toformat = ".XLS", xlExcel8, IIf(toformat = ".XLSX", xlOpenXMLWorkbook, xlOpenXMLWorkbookMacroEnabled)) Application.DisplayAlerts = False 'no user prompting, taking all defaults Application.ScreenUpdating = False fPath = GetFolderName("Select Folder for " & fromFormat & " to " & toformat & " conversion") If fPath = "" Then MsgBox "You didn't select a folder", vbCritical, "Aborting!" Exit Sub Else fName = Dir(fPath & "\*" & fromFormat) If fName = "" Then MsgBox "There aren't any " & fromFormat & " files in the " & fPath & " directory", vbCritical, "Aborting" Exit Sub Else 'get a file count of files to be processed, then process them in the next step Do If UCase(Right(fName, Len(fromFormat))) = UCase(fromFormat) Then 'to differentiate between dir *.xls and inadvertently get *.xls??? ReDim Preserve fFilesToProcess(cntToConvert) As String fFilesToProcess(cntToConvert) = fName cntToConvert = cntToConvert + 1 End If fName = Dir Loop Until fName = "" If cntToConvert = 0 Then 'we were looking for .XLS and there was only .XLS??? or nothing, then abort MsgBox "There aren't any " & fromFormat & " files in the " & fPath & " directory", vbCritical, "Aborting" Exit Sub End If If Not silentMode Then xMsg = MsgBox("There are " & cntToConvert & " " & fromFormat & " files to convert to " & toformat & ". Do you want to delete the " & fromFormat & " files as they are processed?", vbYesNoCancel, "Select an Option") killOnSave = False 'already false, but just a reminder this is in here! If xMsg = vbYes Then killOnSave = True ElseIf xMsg = vbCancel Then GoTo processComplete End If Else pOverWrite = True End If Application.EnableEvents = False 'turn off events so macros don't fire on excel file opens For i = 0 To cntToConvert - 1 'process each file for conversion, displaying status as progress... Application.StatusBar = "Processing: " & i + 1 & " of " & cntToConvert & " file: " & fName fName = fFilesToProcess(i) 'open and convert file On Error GoTo errHandler fOriginalFilePath = fPath & "\" & fName 'you could also check to see if the save as file already exists, before you open convert and save on top! overWrite = False fSaveAsFilePath = fPath & "\" & Mid(fName, 1, Len(fName) - Len(fromFormat)) & toformat If Not pOverWrite Then If FileFolderExists(fSaveAsFilePath) Then xMsg = MsgBox("File: " & fSaveAsFilePath & " already exists, overwrite?", vbYesNoCancel, "Hit Yes to Overwrite, No to Skip, Cancel to quit") If xMsg = vbYes Then overWrite = True ElseIf xMsg = vbCancel Then GoTo processComplete End If Else overWrite = True End If Else overWrite = pOverWrite End If If overWrite Then Set wBook = Application.Workbooks.Open(fOriginalFilePath) If removeMacros And (toformat = ".XLS" Or toformat = ".XLSM") And (fromFormat <> ".XLSX") Then 'use Remove Macro Helper Call RemoveAllMacros(wBook) End If wBook.SaveAs Filename:=fSaveAsFilePath, FileFormat:=saveFormat wBook.Close savechanges:=False numconverted = numconverted + 1 'optionally, you can delete the file you converted from If killOnSave And fromFormat <> toformat Then Kill fOriginalFilePath End If End If Next i End If End If processComplete: On Error GoTo 0 MsgBox "Completed " & numconverted & " " & fromFormat & " to " & toformat & " conversions", vbOKOnly Application.EnableEvents = True 'uncomment if doing other conversions where macros are involved in source workbooks Application.StatusBar = False Application.DisplayAlerts = True Application.ScreenUpdating = False Exit Sub errHandler: Application.StatusBar = False MsgBox "For some reason, could not open/save the file: " & fPath & "\" & fName, vbCritical, "Aborting!" Resume processComplete End Sub