Macro stops
Posted by Kristoffer Sjoo on July 27, 2000 12:32 AM
I've written a macro that opens the workbook files that selected hyperlinks in a 'menu' worksheet point to, retrieves the data in the files that's new enough, and puts it all in a single, new workbook.
Problem is, the macro just stops running (no message, no nothing) after opening the first selected file. This is prevented by placing a Stop at the beginning of the macro, and then when the execution is halted resuming with F5. The macro then performs as it should. Nevertheless, I don't consider this a viable solution long-term.
Why does the Open stop the execution?
Here's the listing: (Sorry about the identifiers being in Swedish)
Sub Generera_rapport_MkII()
Stop
ChDir ("p:\d2k\labbet\kemidata")
Dim in_datum As Variant
Do
in_datum = InputBox("Välj startdatum för rapporten", "Startdatum", DateAdd("m", -1, Now))
If Not (in_datum = "" Or IsDate(in_datum)) Then in_datum = MsgBox("Felaktigt datum", vbExclamation)
Loop Until (in_datum = "" Or IsDate(in_datum))
If in_datum = "" Then End
Dim startbok As Excel.Workbook
Set startbok = Application.ActiveWorkbook
Dim rapport As Excel.Workbook
Set rapport = Workbooks.Add
Dim databok As Excel.Workbook
Dim punktnamn As String
Dim filnamn As String
startbok.Activate
For Each c In Selection
For Each h In c.Hyperlinks
startbok.Activate
Let punktnamn = Cells(c.Row, c.Column - 1).Value & "-" & c.Value
rapport.Activate
With Selection
.Value = punktnamn
.Font.Bold = True
End With
Cells(Selection.Row + 1, 1).Select
Let filnamn = h.Name
Workbooks.Open (filnamn)
' It halts right here, if not in debug
' mode
Set databok = Application.ActiveWorkbook
ActiveSheet.Range("A2").Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Dim i As Integer
Let i = 1
Dim datum As Variant
Do
Let i = i + 1
datum = Range("A" & i).Value
Loop While datum <> "" And datum > CDate(in_datum)
Range("A1:BA" & i - 1).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Rows("1:" & i - 1).Copy
rapport.Activate
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeLastCell).Select
Cells(Selection.Row + 2, 1).Select
Range("A1").Copy
databok.Close (False)
Next
Next
Columns("A:A").AutoFit
Let Columns("B:D").ColumnWidth = 9
ScreenUpdating = True
End Sub