View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default 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/