View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
[email protected] michele@quality-computing.com is offline
external usenet poster
 
Posts: 19
Default Script out of range error

Hi,

Yes, you're right, both files are the same now. I had it that way for
something that's not in the program anymore. So I've just put 'qrFile
= ThisWorkbook.Name' after the If Else.

However, I still can't get the macro to work. It's now stopping with
'Path not found' on the 'Error errnum' (third last line) in the
IsFileOpen module which it never did before. At this time, it's not
open. Here's the module and the code. I didn't include this part of
the code in the code above before as I took it out for simplicity, but
it was there.

-----------Here is the IsFileOpen module

Function IsFileOpen(FileName As String)
Dim filenum As Integer, errnum As Integer

On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open FileName For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.

' Check to see which error occurred.
Select Case errnum

' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False

' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True

' Another error occurred.
Case Else
Error errnum
End Select
End Function

------------Here is the macro

Sub ProcessCS()

'Macro6 Macro

Const qfPath = "C:\Documents and Settings\John\My
Documents\quoteprogramfiles\"
Const qrPath = "C:\Documents and Settings\John\My
Documents\CSQuotes\"

' Check if you are in the quote or a processed quote
If isFile(qfPath & "CSQuoteForm.xls") = False Then
response = MsgBox("This quote has already been processed. Do
you want to create a new quote with a new quote number by copying this
already processed quote?", _
vbYesNo + vbQuestion)
Exit Sub
Else
response = vbNo
End If

qfFile = ThisWorkbook.Name

' Quit if quote report is open and open if not
If IsFileOpen(qrPath & qrFile) = True Then
MsgBox "Quote report is open. Save and close " & qrFile & "
and try again."
Exit Sub
Else
Workbooks.Open qrPath & qrFile
End If

' Get last quote# and paste next quote# in report
Range("A1").Select
Selection.End(xlDown).Select
Dim z As Integer
q = ActiveCell.Value + 1
Selection.Offset(1, 0).Select
ActiveCell = q

' Paste next quote# in quote
Windows(qfFile).Activate
Range("F3").Select
ActiveCell = q

I would really appreciate some help on this. I hope it's not me being
stupid. It's probably my If Else End stuff because I'm not very good
at that.

Thank you,

Michele