|
Excel 2000/XP script to Excel97 script
Hi,
I have the following code which works perfectly within excel 2000 o xp. I need to be able to run it from an excel 97 environment - a present it fails to run. I believe the problem is caused by the replac code, but I'm not sure how to fix it. Any help would be appreciated. [vb] Public Sub ProcessPPT() Dim FolderName As String, FileToRename As String, FinishedWith A String Dim NewFolder As String, NewFullName As String, SheetName As String 'build the path where you're files are stored now FolderName = "C:\PPT-in\" FileToRename = Dir(FolderName & "\*.xls") 'replace the folders to : NewFolder = "C:\PPT-out\" FinishedWith = "C:\PPT-original\" 'loop through the files Do While FileToRename < "" ProcessPPTSheets FileToRename, FolderName, NewFolder, NewFullName FinishedWith 'and replace/rename the files FileToRename = Dir(FolderName & "\*.xls") Loop MsgBox ("All PPT files from C:\PPT-in have been processed and will b in c:\PPT-out. The original files have been moved to C:\PPT-original") End Sub Public Sub ProcessPPTSheets(FileToRename As Variant, FolderName A Variant, NewFolder As Variant, NewFullName As Variant, FinishedWith A Variant) Dim s As Integer Dim t As Integer s = 0 Workbooks.Open (FolderName & FileToRename) For s = 1 To ActiveWorkbook.Worksheets.Count Worksheets(s).Name = "Sheet" & s Next s For t = 1 To ActiveWorkbook.Sheets.Count Sheets(t).Select Range("C3").Select C5Value = "_" & Mid(Range("C5").Value, 1, 1) If Range("C3").Value < "" Then Sheets(t).Copy If InStr(Range("C3").Value, "/") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, "/", C5Value) & "_PPT" ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check i file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, "/", C5Value) "_PPT" & i & ".xls" Loop Else If InStr(Range("C3").Value, "-") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, "-", C5Value) & "_PPT" ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check i file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, "-", C5Value) "_PPT" & i & ".xls" Loop Else If InStr(Range("C3").Value, ".") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, ".", C5Value) & "_PPT" ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check i file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, ".", C5Value) "_PPT" & i & ".xls" Loop Else i = 0 NewFullName = "A" & Range("C3") & C5Value & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check i file already exists i = i + 1 'increment NewFullName = "A" & Range("C3") & C5Value & "_PPT" & i & ".xls" Loop End If End If End If ActiveWorkbook.SaveAs NewFolder & NewFullName ActiveWorkbook.Close savechanges:=False Else End If Next t ActiveWorkbook.Close savechanges:=False Name FolderName & FileToRename As FinishedWith & FileToRename End Sub [/vb -- Message posted from http://www.ExcelForum.com |
Excel 2000/XP script to Excel97 script
Replace as added in VBA6 (xl2000 and later). You can use the worksheet
function substitute in all verions Application.Substitute vice Replace best to do development on the lowest level version where the code will be run. -- Regards, Tom Ogilvy "hat " wrote in message ... Hi, I have the following code which works perfectly within excel 2000 or xp. I need to be able to run it from an excel 97 environment - at present it fails to run. I believe the problem is caused by the replace code, but I'm not sure how to fix it. Any help would be appreciated. [vb] Public Sub ProcessPPT() Dim FolderName As String, FileToRename As String, FinishedWith As String Dim NewFolder As String, NewFullName As String, SheetName As String 'build the path where you're files are stored now FolderName = "C:\PPT-in\" FileToRename = Dir(FolderName & "\*.xls") 'replace the folders to : NewFolder = "C:\PPT-out\" FinishedWith = "C:\PPT-original\" 'loop through the files Do While FileToRename < "" ProcessPPTSheets FileToRename, FolderName, NewFolder, NewFullName, FinishedWith 'and replace/rename the files FileToRename = Dir(FolderName & "\*.xls") Loop MsgBox ("All PPT files from C:\PPT-in have been processed and will be in c:\PPT-out. The original files have been moved to C:\PPT-original") End Sub Public Sub ProcessPPTSheets(FileToRename As Variant, FolderName As Variant, NewFolder As Variant, NewFullName As Variant, FinishedWith As Variant) Dim s As Integer Dim t As Integer s = 0 Workbooks.Open (FolderName & FileToRename) For s = 1 To ActiveWorkbook.Worksheets.Count Worksheets(s).Name = "Sheet" & s Next s For t = 1 To ActiveWorkbook.Sheets.Count Sheets(t).Select Range("C3").Select C5Value = "_" & Mid(Range("C5").Value, 1, 1) If Range("C3").Value < "" Then Sheets(t).Copy If InStr(Range("C3").Value, "/") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, "/", C5Value) & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, "/", C5Value) & "_PPT" & i & ".xls" Loop Else If InStr(Range("C3").Value, "-") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, "-", C5Value) & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, "-", C5Value) & "_PPT" & i & ".xls" Loop Else If InStr(Range("C3").Value, ".") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, ".", C5Value) & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, ".", C5Value) & "_PPT" & i & ".xls" Loop Else i = 0 NewFullName = "A" & Range("C3") & C5Value & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Range("C3") & C5Value & "_PPT" & i & ".xls" Loop End If End If End If ActiveWorkbook.SaveAs NewFolder & NewFullName ActiveWorkbook.Close savechanges:=False Else End If Next t ActiveWorkbook.Close savechanges:=False Name FolderName & FileToRename As FinishedWith & FileToRename End Sub [/vb] --- Message posted from http://www.ExcelForum.com/ |
Excel 2000/XP script to Excel97 script
Replace does not exist in XL97. You could always write your own if so
disposed Function Replace97(Source As String, Find As String, Replace As String) Dim iPos As Long Dim sTemp As String sTemp = Source Do iPos = InStr(sTemp, Find) sTemp = Left(sTemp, iPos - 1) & Replace & Right(sTemp, Len(sTemp) - Len(Find) - iPos + 1) Loop Until InStr(sTemp, Find) = 0 Replace97 = sTemp End Function -- HTH Bob Phillips ... looking out across Poole Harbour to the Purbecks (remove nothere from the email address if mailing direct) "hat " wrote in message ... Hi, I have the following code which works perfectly within excel 2000 or xp. I need to be able to run it from an excel 97 environment - at present it fails to run. I believe the problem is caused by the replace code, but I'm not sure how to fix it. Any help would be appreciated. [vb] Public Sub ProcessPPT() Dim FolderName As String, FileToRename As String, FinishedWith As String Dim NewFolder As String, NewFullName As String, SheetName As String 'build the path where you're files are stored now FolderName = "C:\PPT-in\" FileToRename = Dir(FolderName & "\*.xls") 'replace the folders to : NewFolder = "C:\PPT-out\" FinishedWith = "C:\PPT-original\" 'loop through the files Do While FileToRename < "" ProcessPPTSheets FileToRename, FolderName, NewFolder, NewFullName, FinishedWith 'and replace/rename the files FileToRename = Dir(FolderName & "\*.xls") Loop MsgBox ("All PPT files from C:\PPT-in have been processed and will be in c:\PPT-out. The original files have been moved to C:\PPT-original") End Sub Public Sub ProcessPPTSheets(FileToRename As Variant, FolderName As Variant, NewFolder As Variant, NewFullName As Variant, FinishedWith As Variant) Dim s As Integer Dim t As Integer s = 0 Workbooks.Open (FolderName & FileToRename) For s = 1 To ActiveWorkbook.Worksheets.Count Worksheets(s).Name = "Sheet" & s Next s For t = 1 To ActiveWorkbook.Sheets.Count Sheets(t).Select Range("C3").Select C5Value = "_" & Mid(Range("C5").Value, 1, 1) If Range("C3").Value < "" Then Sheets(t).Copy If InStr(Range("C3").Value, "/") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, "/", C5Value) & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, "/", C5Value) & "_PPT" & i & ".xls" Loop Else If InStr(Range("C3").Value, "-") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, "-", C5Value) & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, "-", C5Value) & "_PPT" & i & ".xls" Loop Else If InStr(Range("C3").Value, ".") 0 Then i = 0 NewFullName = "A" & Replace(Range("C3").Value, ".", C5Value) & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Replace(Range("C3").Value, ".", C5Value) & "_PPT" & i & ".xls" Loop Else i = 0 NewFullName = "A" & Range("C3") & C5Value & "_PPT" & ".xls" Do While Dir(NewFolder & "\" & NewFullName) < "" 'check if file already exists i = i + 1 'increment NewFullName = "A" & Range("C3") & C5Value & "_PPT" & i & ".xls" Loop End If End If End If ActiveWorkbook.SaveAs NewFolder & NewFullName ActiveWorkbook.Close savechanges:=False Else End If Next t ActiveWorkbook.Close savechanges:=False Name FolderName & FileToRename As FinishedWith & FileToRename End Sub [/vb] --- Message posted from http://www.ExcelForum.com/ |
Excel 2000/XP script to Excel97 script
Hi,
Thanks for all your help. The Application.Substitution() did ecerything I wanted. Best --- Message posted from http://www.ExcelForum.com/ |
| All times are GMT +1. The time now is 02:58 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com