Hi again Bob . . .
It works beautifully. Thank You Much.
I do have one more macro to be modifed in the same way you did for Excel.
The following one is for Word. It is to work in the same way as Excel does
when opening a file. Hopefully, since you know what you did in Excel, the
changes for Word should be alot easier.
If you will be kind enough . . . please help me. I think this is the last
code I need help with for now.
THE FOLLOWING IS MY "WORD" CODE with copying your changes into my code as far
as I could go. I've noted in the code what I've done.
Sub NewWordWithDocument()
Dim oWordApp As Object
Dim oWordDoc As Object
Set oWordApp = CreateObject("Word.Application")
Dim testFileFind
Dim oWB As Object
ActiveCell.Offset(0, -1).Activate 'this moves the selected cell 1 cell to
the Left
'The following tests for a blank cell and ends processing
'It is needed because dir() function will not work with a blank.
If Len(Trim(ActiveCell)) = 0 Then
MsgBox "Active Cell " & ActiveCell.Address & " is blank. You have not
entered a Path & File Name."
End
End If
'I THINK THIS IS THE CODE THAT YOU USED FOR EXCEL.
'Check if the file is already open, do nothing if so
If Not IsFileOpen(ActiveCell.Value) Then
'THIS LINE OF CODE OPENS THE NEW INSTANCE OF EXCEL.
Set oXL = CreateObject("Excel.Application")
'THIS LINE OF CODE MAKES THE NEW INSTANCE OF EXCEL VISIBLE.
oXL.Visible = True
Set oWB = oXL.Workbooks.Open(ActiveCell)
Else
MsgBox "File " & ActiveCell.Value & " is already open"
End If
End Sub
'THE FOLLOWING IS THE BALANCE OF THE CODE I USE TO OPEN WORD DOCUMENT.
'NATURALLY, WE CAN'T HAVE 2 . . . End Sub's
'IN REVIEWING YOUR CODE (EXCEL) AND THE CHANGES ADDED TO MY ORIGINAL CODE, I
'THINK THAT SOME OF THE FOLLOWING CODE HAS TO BE INCORPORATED INTO ABOVE
'PLUS, I AM SURE I NEED THE FUNCTION. (AS IS . . . OR DOES IT HAVE TO BE
CHANGED ?
'The following tests for the existance of the file
testFileFind = Dir(ActiveCell)
'If the file is not found there will be nothing
'in the variable and processing ends.
If Len(testFileFind) = 0 Then
MsgBox "Invalid selection." & Chr(13) & _
"Filename " & ActiveCell & " not found"
End
End If
'THIS LINE OF CODE OPENS THE NEW INSTANCE OF WORD.
Set oWordApp = CreateObject("Word.Application")
'THIS LINE OF CODE MAKES THE NEW INSTANCE OF WORD VISIBLE.
oWordApp.Visible = True
Set oWordDoc = oWordApp.Documents.Open(ActiveCell.Text)
End Sub
'HERE IS YOUR FUNCTION CODE, WHICH I DON'T UNDERSTAND AT ALL.
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Bob Phillips wrote:
Matt,
In that casr it should be as simple as
Sub NewExcelWithWorkbook()
Dim oXL As Object 'This is needed to open a new instance of Excel.
'Without it, the file is only opened as a new Window
Dim testFileFind
Dim oWB As Object
ActiveCell.Offset(0, -1).Activate 'this moves selected cell 1 to Left
'The following tests for a blank cell and ends processing
'It is needed because dir() function will not work with a blank.
If Len(Trim(ActiveCell)) = 0 Then
MsgBox "Active Cell " & ActiveCell.Address & " is blank. " & _
"You have not entered a Path & File Name."
End
End If
'The following tests for the existance of the file
testFileFind = Dir(ActiveCell)
'If the file is not found there will be nothing
'in the variable and processing ends.
If Len(testFileFind) = 0 Then
MsgBox "Invalid selection." & Chr(13) & _
"Filename " & ActiveCell & " not found"
End
End If
'Check if the file is already open, do nothing if so
If Not IsFileOpen(ActiveCell.Value) Then
'THIS LINE OF CODE OPENS THE NEW INSTANCE OF EXCEL.
Set oXL = CreateObject("Excel.Application")
'THIS LINE OF CODE MAKES THE NEW INSTANCE OF EXCEL VISIBLE.
oXL.Visible = True
Set oWB = oXL.Workbooks.Open(ActiveCell)
Else
MsgBox "File " & ActiveCell.Value & " is already open"
End If
End Sub
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Hi Bob . . . I know its long, but I think it is needed to help tell you
what
[quoted text clipped - 94 lines]
Can someone please give me a hand ?
--
Please take a look at
www.openoursite.com Click on: "Keywords" and then
Click on "Matt's Story" and if you are a man, you should be very happy that
you read my story. God Bless for everyones help.
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200708/1