Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
help with EXCEL SCRIPT | Excel Discussion (Misc queries) | |||
help with EXCEL SCRIPT | Excel Discussion (Misc queries) | |||
help with EXCEL SCRIPT | Excel Discussion (Misc queries) | |||
VBA Script in Excel | Excel Programming | |||
command line script for printing MS Excel 2000 document. | Excel Programming |