Hi Folks
Can anyone help with code that will list in an Excel worksheet, the names and paths of all open documents - both MS Excel and MS Word.
I have this code but it only works for Excel workbooks:
Sub ExcelFilesOpen()
Application.EnableEvents = True
Dim str1 As String
str1 = ActiveSheet.Name
For Each Workbook In Application.Workbooks
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(1, 0).Value = Date
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(0, 1).Value = Time
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(0, 2).Value = Workbook.Name
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(0, 3).Value = Workbook.Path
Next
End Sub
The listed files are then opened by a right click event macro:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 2 And Target.Column <> 4 Then Exit Sub
If Target.Row < 4 Then Exit Sub
Cancel = True
If Target.Column = 2 Then
ActiveSheet.Unprotect
Target.EntireRow.Delete
ActiveSheet.Protect
Exit Sub
End If
If Target.Column = 4 Then
Dim fn As String
fn = Target.Offset(0, 1).Value & "\" & Target.Value
On Error Resume Next
Workbooks.Open FileName:=fn
End If
End Sub
Many thanks
Derek
Can anyone help with code that will list in an Excel worksheet, the names and paths of all open documents - both MS Excel and MS Word.
I have this code but it only works for Excel workbooks:
Sub ExcelFilesOpen()
Application.EnableEvents = True
Dim str1 As String
str1 = ActiveSheet.Name
For Each Workbook In Application.Workbooks
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(1, 0).Value = Date
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(0, 1).Value = Time
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(0, 2).Value = Workbook.Name
ThisWorkbook.Sheets(str1).Range("B65536").End(xlUp).Offset(0, 3).Value = Workbook.Path
Next
End Sub
The listed files are then opened by a right click event macro:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 2 And Target.Column <> 4 Then Exit Sub
If Target.Row < 4 Then Exit Sub
Cancel = True
If Target.Column = 2 Then
ActiveSheet.Unprotect
Target.EntireRow.Delete
ActiveSheet.Protect
Exit Sub
End If
If Target.Column = 4 Then
Dim fn As String
fn = Target.Offset(0, 1).Value & "\" & Target.Value
On Error Resume Next
Workbooks.Open FileName:=fn
End If
End Sub
Many thanks
Derek