Code stops on successful Workbook Open

[Scott Huish]

Hi, I have the following code.
The code completely stops if it successfully opens the workbook. No error, it just opens the workbook and then nothing else happens.
I have put in a checkpoint in the code to see if it actually gets that far and it only continues the code if the file did not exist.
Column A does contain valid dates in the workbook this code is running from. Any ideas?

Sub GetPressRun()
On Error Resume Next
Dim fp As String, cf As String, fn As String, dt As Date
Dim li As Range

Set li = Cells(ActiveCell.Row, 1)
dt = li
fp = "J:\Paper Sections\pressrun\"
fn = "Run Sheet (" & Format(dt, "m-d-yyyy") & ").xls"

If Dir(fp & fn) <> "" Then
    Workbooks.Open fp & fn
Else
    MsgBox "Press Run for date " & dt & " does not exist", vbExclamation
    Exit Sub
End If

'Checkpoint #1
cf = ActiveWorkbook.Name
MsgBox cf

With Workbooks(fn).Sheets(1)
    li.Offset(, 1) = .Range("E34")
    li.Offset(, 4) = .Range("E25")
    li.Offset(, 12) = .Range("E29") + .Range("E30")
End With

Workbooks(fn).Close False
End Sub

 

[Scott Huish]

I have done some testing and it seems that everytime I used shift as a shortcut to call a macro that opened a workbook it would open in design mode even with low security.

Yep, found it here:

http://support.microsoft.com/kb/212074/en-us

Apparently it's been a problem since XL97.

 

[schielrn]

Then while in design mode I have found that macros do not continue. So once in design mode you can't send keys or anything to get back out of design mode from what I could find.

 

[Jonmo1]

I thought maybe this KB article at Microsoft was similar to the problem
http://support.microsoft.com/kb/824007/en-us

It gave a workaround of adding a digital signature....
....
....
Didn't Work.

 

[Jonmo1]

I even tried

Sub Macro1()
Application.Run "Macro2"
End Sub

Sub Macro1()
Workbooks.Open "C:\Path\Filename.xls"
End Sub

And setting the shortcut to Macro1

That didn't work either.

 

[Jonmo1]

I have found solution, or workaround anyway...

I don't know what it's called, but you know when you click the bar to the left of your code, and it puts the little red dot there, and your code stops at that point?...Do that on the line that opens the book...

Now, before the line that opens the book put

Application.SendKeys ("{F5}") - Tells VBE to Continue Code
Application.SendKeys ("%{F11}") - Minimizes VBE Window

So example code that I have gotten to work using CTRL+SHIFT+Q Shortcut.

Sub Test()

Application.SendKeys ("{F5}") ' Tells VBE to Continue Code
Application.SendKeys ("%{F11}") 'Tells VBE To Minimize VBE Window
Workbooks.Open ("C:\Path\test.xls")

For i = 1 To 3
MsgBox i
Next i
Application.SendKeys ("%q") 'Tells VBE To Close VBE Window
End Sub

This seems to work.

 

[Legacy 98055]

Have run into a similiar problem when dynamically adding oleobjects. Maybe the same workaround will work here? Obviously, when you go into design mode, your project loses state. All variables have to be reassigned.

<table width="100%" border="1" bgcolor="White" style="filterrogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Const</font> fp <font color="#0000A0">As</font> <font color="#0000A0">String</font> = "J:\Paper Sections\pressrun\"

  <font color="#0000A0">Sub</font> GetPressRunPart1()
       <font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">Resume</font> <font color="#0000A0">Next</font>

       <font color="#0000A0">Dim</font> li <font color="#0000A0">As</font> Range, dt <font color="#0000A0">As</font> Date, fn <font color="#0000A0">As</font> <font color="#0000A0">String</font>

       <font color="#0000A0">Set</font> li = Cells(ActiveCell.Row, 1)
       dt = li
       fn = "Run Sheet (" & Format(dt, "m-d-yyyy") & ").xls"

       <font color="#0000A0">If</font> Dir(fp & fn) <> "" <font color="#0000A0">Then</font>
           Workbooks.Open fp & fn
  <font color="#008000">' you may need to add a second to now such as</font>
  <font color="#008000">' Now + TimeSerial(0, 0, 1)</font>
  <font color="#008000">' procede procedure name with codename if your code is in a public object module</font>
  <font color="#008000">' Application.OnTime Now, "ThisWorkbook.GetPressRunPart2"</font>
           Application.OnTime Now, "GetPressRunPart2"
           <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
       <font color="#0000A0">Else</font>
           MsgBox "Press Run for date " & dt & " does not exist", vbExclamation
           <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       GetPressRunPart2

  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Sub</font> GetPressRunPart2()
       <font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">Resume</font> <font color="#0000A0">Next</font>

       <font color="#0000A0">Dim</font> li <font color="#0000A0">As</font> Range, dt <font color="#0000A0">As</font> Date, cf <font color="#0000A0">As</font> String, fn <font color="#0000A0">As</font> <font color="#0000A0">String</font>

       <font color="#0000A0">Set</font> li = Cells(ActiveCell.Row, 1)
       dt = li
       fn = "Run Sheet (" & Format(dt, "m-d-yyyy") & ").xls"

      <font color="#008000"> 'Checkpoint #1</font>
       cf = ActiveWorkbook.Name
       MsgBox cf

       <font color="#0000A0">With</font> Workbooks(fn).Sheets(1)
           li.Offset(, 1) = .Range("E34")
           li.Offset(, 4) = .Range("E25")
           li.Offset(, 12) = .Range("E29") + .Range("E30")
       <font color="#0000A0">End</font> <font color="#0000A0">With</font>

       Workbooks(fn).Close <font color="#0000A0">False</font>
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

</FONT></td></tr></table><button onclick='document.all("1031200785857396").value=document.all("1031200785857396").value.replace(/<br \/>\s\s/g,"");document.all("1031200785857396").value=document.all("1031200785857396").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("1031200785857396").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="1031200785857396" wrap="virtual">
Option Explicit

Const fp As String = "J:\Paper Sections\pressrun\"

Sub GetPressRunPart1()
On Error Resume Next

Dim li As Range, dt As Date, fn As String

Set li = Cells(ActiveCell.Row, 1)
dt = li
fn = "Run Sheet (" & Format(dt, "m-d-yyyy") & ").xls"

If Dir(fp & fn) <> "" Then
Workbooks.Open fp & fn
' you may need to add a second to now such as
' Now + TimeSerial(0, 0, 1)
' procede procedure name with codename if your code is in a public object module
' Application.OnTime Now, "ThisWorkbook.GetPressRunPart2"
Application.OnTime Now, "GetPressRunPart2"
Exit Sub
Else
MsgBox "Press Run for date " & dt & " does not exist", vbExclamation
Exit Sub
End If

GetPressRunPart2

End Sub

Sub GetPressRunPart2()
On Error Resume Next

Dim li As Range, dt As Date, cf As String, fn As String

Set li = Cells(ActiveCell.Row, 1)
dt = li
fn = "Run Sheet (" & Format(dt, "m-d-yyyy") & ").xls"

'Checkpoint #1
cf = ActiveWorkbook.Name
MsgBox cf

With Workbooks(fn).Sheets(1)
li.Offset(, 1) = .Range("E34")
li.Offset(, 4) = .Range("E25")
li.Offset(, 12) = .Range("E29") + .Range("E30")
End With

Workbooks(fn).Close False
End Sub
</textarea>

 

[JuulkeFlup]

Hi,

I'm a pretty newbie and had the same problem. I have a macro in which I want write code into the ThisWorkbook area of the activeworkbook. I call the procedure via an add-in.
After opening a new workbook and running this macro I get the runtime error. After clicking the Debug option I can step through the macro with F8 and the macro works.
I solved this issue by adding a On resume goto label. The macro returns to a prior point and runs! Magic!

My Code:

Sub TurnON()
Dim bReplace As Boolean
Dim sFile As String
sFile = "C:\ThisWorkbook.txt"
bTeplace = True
label:
BookName = ActiveWorkbook.Name
On Error GoTo label
With Workbooks(BookName).VBProject.VBComponents(Workbooks(BookName).CodeName).CodeModule
If bReplace Then .DeleteLines StartLine:=1, Count:=.CountOfLines
.AddFromFile sFile
End With
End Sub

It worked for me, hopefully also for somebody out there.