S
Seanie
Has the way you can populate ThisWorkbook via VBA changed in 2007 from
2003. The code below worked perfectly in 2003, but ThisWorkbook is
completely blank when run under 2007.
Sub Populate_TW()
Dim StartLine As Long
Dim msg1 As String, msg2 As String
Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If
msg1 = "Dim myArray As Variant" & vbCr & _
"Dim arName As String" & vbCr & _
"Dim ws As Worksheet" & vbCr & _
"arName = ""MyUsers""" & vbCr & _
"myArray = ThisWorkbook.Names(arName).RefersToRange.Value" & vbCr & _
"application.screenupdating=false"
msg2 = "With Application" & vbCr & _
"If IsError(.Application.Match(.UserName, myArray, 0)) Then " & vbCr &
_
"MsgBox ""You are NOT Permitted to access this File "" & vbCr & _" &
vbCr & _
""""" & vbCr & _" & vbCr & _
"""Please Contact Joe Bloggs at "" & vbCr & _" & vbCr & _
""""" & vbCr & _" & vbCr & _
"""123 Group +00999 1 9999999""" & vbCr & _
"Application.DisplayAlerts = False" & vbCr & _
"ThisWorkbook.Close False" & vbCr & _
"Else" & vbCr & _
"For Each ws In Worksheets" & vbCr & _
"ws.Visible = True" & vbCr & _
"Next" & vbCr & _
"Worksheets(""E-Blank"").Visible = False" & vbCr & _
"Worksheets(""E-Users"").Visible = xlVeryHidden" & vbCr & _
"Worksheets(""E-Sales"").Activate" & vbCr & _
"Application.DisplayAlerts = True" & vbCr & _
"End If" & vbCr & _
"End With"
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
..InsertLines StartLine, msg1 & vbCr & msg2
End With
Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub
2003. The code below worked perfectly in 2003, but ThisWorkbook is
completely blank when run under 2007.
Sub Populate_TW()
Dim StartLine As Long
Dim msg1 As String, msg2 As String
Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If
msg1 = "Dim myArray As Variant" & vbCr & _
"Dim arName As String" & vbCr & _
"Dim ws As Worksheet" & vbCr & _
"arName = ""MyUsers""" & vbCr & _
"myArray = ThisWorkbook.Names(arName).RefersToRange.Value" & vbCr & _
"application.screenupdating=false"
msg2 = "With Application" & vbCr & _
"If IsError(.Application.Match(.UserName, myArray, 0)) Then " & vbCr &
_
"MsgBox ""You are NOT Permitted to access this File "" & vbCr & _" &
vbCr & _
""""" & vbCr & _" & vbCr & _
"""Please Contact Joe Bloggs at "" & vbCr & _" & vbCr & _
""""" & vbCr & _" & vbCr & _
"""123 Group +00999 1 9999999""" & vbCr & _
"Application.DisplayAlerts = False" & vbCr & _
"ThisWorkbook.Close False" & vbCr & _
"Else" & vbCr & _
"For Each ws In Worksheets" & vbCr & _
"ws.Visible = True" & vbCr & _
"Next" & vbCr & _
"Worksheets(""E-Blank"").Visible = False" & vbCr & _
"Worksheets(""E-Users"").Visible = xlVeryHidden" & vbCr & _
"Worksheets(""E-Sales"").Activate" & vbCr & _
"Application.DisplayAlerts = True" & vbCr & _
"End If" & vbCr & _
"End With"
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
..InsertLines StartLine, msg1 & vbCr & msg2
End With
Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub