View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
hat hat is offline
external usenet poster
 
Posts: 1
Default 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