RichardMGreen
Well-known Member
- Joined
- Feb 20, 2006
- Messages
- 2,177
but fails with an error if I just try to run it.
I have the following code :-
If I step through the code, it works fine and reacts as expected (including breaking the links when creating the output file).
However, if I just run the macro from the button on the "Control" sheet, it fails on this line:-
and jumps to the dropout section.
Can anyone explain why or how I can reset the "On Error" so I get a proper error message if it fails?
I have the following code :-
Code:
Sub Import_data()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, cmd As ADODB.Command
Dim wsData As Worksheet, wsDst As Worksheet, ws As Worksheet, wb As Workbook
Dim rngData As Range, rngDst As Range, qt As QueryTable
Dim strQry As String, strSQL As String, file As String, strConn As String
'----- Check if data retrieval should be bypassed - if so, go straight to file creation -----
If Sheets("Control").Range("D5") <> "Y" Then
Set wsData = Worksheets("SQL Data")
file = wsData.Range("G2")
'----- Clear out old data and set up userform -----
maxquery = Sheets("SQL Data").Range("A65535").End(xlUp).Row - 1
currentquery = 0
UserForm1.Show
UserForm1.Label1.Caption = "Refreshing Database Queries..."
UserForm1.ProgressBar1.Value = 0
UserForm1.Repaint
'----- Turn off calculations and clear current data -----
Application.Calculation = xlCalculationManual
Sheets("IntradayData").Rows("4:10000").ClearContents
Sheets("DailyData").Rows("4:10000").ClearContents
Sheets("CallDetail").Rows("4:10000").ClearContents
'----- Get all data -----
Set conn = New ADODB.Connection
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & file & ";Persist Security Info=False;"
conn.ConnectionString = strConn
conn.Open
Set rngData = wsData.Range("A2")
Set cmd = New ADODB.Command
On Error GoTo error_line
While rngData.Value <> ""
strQry = "[" & rngData.Value & "]"
strSQL = "SELECT * FROM " & strQry
offsetrow = 1
cmd.CommandType = adCmdText
cmd.CommandText = strSQL
cmd.ActiveConnection = conn
'----- Pick up information on where data is to go -----
Set wsDst = Worksheets(rngData.Offset(, 1).Value)
Set rngDst = wsDst.Range(rngData.Offset(, 2).Value)
'----- Retrieve data from database and insert into correct cells -----
Set rs = cmd.Execute
If Not IsNull(rngDst) Then rngDst.CopyFromRecordset rs
currentquery = currentquery + 1
'----- Make sure no data left to write and set up details for next query -----
error_line:
Err.Clear
On Error GoTo error_line
Set rs = Nothing
Set rngData = rngData.Offset(offsetrow)
UserForm1.ProgressBar1.Value = (currentquery / (maxquery + 1)) * 100
UserForm1.Repaint
Wend
Set conn = Nothing
'----- Adjust formulas on data sheets as necessary -----
Sheets("IntradayData").Select
Range("K3:L3").Copy
lastrow = Range("J65535").End(xlUp).Row + 1
Range("K4:K" & lastrow).PasteSpecial (xlPasteAll)
Range("A1").Select
Sheets("IntradayData").Select
Range("BL3:BN3").Copy
lastrow = Range("BK65535").End(xlUp).Row + 1
Range("BL4:BL" & lastrow).PasteSpecial (xlPasteAll)
Range("A1").Select
Sheets("DailyData").Select
Range("AY3:BD3").Copy
lastrow = Range("AX65535").End(xlUp).Row + 1
Range("AY4:AY" & lastrow).PasteSpecial (xlPasteAll)
Range("A1").Select
'----- Save template with refreshed data -----
Sheets("Control").Select
ActiveWorkbook.Save
End If
'----- Create final output file -----
If UserForm1.Visible = False Then UserForm1.Show
On Error GoTo dropout
UserForm1.Label1.Caption = "Creating Output..."
UserForm1.ProgressBar1.Value = ((currentquery + 1) / (maxquery + 1)) * 100
UserForm1.Repaint
Application.Calculate
'----- Create new workbook for output and set calculations to automatic -----
Set wb = Workbooks.Add
ThisWorkbook.Sheets(Array("National View", "NE Report", "All Luton", "Luton Report", "Luton 111", _
"E Mids", "All Nott", "Nott OOH Report", "Nott 111 Report", "Lincoln Report", "ChartData32Days", _
"FRONT", "Definitions")).Copy After:=wb.Sheets(3)
Application.DisplayAlerts = False
wb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
break_link_name = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wb.BreakLink Name:=break_link_name, Type:=xlExcelLinks
Application.DisplayAlerts = True
'----- Create values-only copy of sheets -----
For Each ws In wb.Worksheets
ws.Select
Cells.Copy
Cells.PasteSpecial (xlPasteValues)
Range("A1").Select
Next
wb.Sheets("ChartData32Days").Visible = False
wb.Sheets("Front").Select
'----- Set up variables for saving report -----
ReportingDate = Format(ThisWorkbook.Sheets("Control").Range("D2").Value, " yyyy-mm-dd")
OutputLocation = ThisWorkbook.Sheets("Control").Range("D3")
SaveName = ThisWorkbook.Sheets("Control").Range("D4")
Vsion = 1
'----- Save new workbook with version control -----
Do While FileExists(OutputLocation & SaveName & ReportingDate & " v" & Vsion & ".xls")
Vsion = Vsion + 1
Loop
Application.Calculation = xlCalculationAutomatic
wb.SaveAs Filename:=OutputLocation & SaveName & ReportingDate & " v" & Vsion & ".xls"
wb.Close False
'----- Select first cell on each visible sheet -----
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Visible = xlSheetVisible Then
ws.Select
Range("A1").Select
End If
Next
Sheets("Control").Select
Application.ScreenUpdating = True
Unload UserForm1
If currentquery < maxquery Then
response = MsgBox("Not all queries have successfully updated" & Chr(10) & _
"Please rerun this macro", vbOKOnly, "XXX WARNING XXX")
End If
Exit Sub
dropout:
response = MsgBox("Problem occurred creating output file" & Chr(10) & _
"Please rerun this macro after changing 'Bypass data refresh?' to Y", vbOKOnly, "XXX WARNING XXX")
End Sub
If I step through the code, it works fine and reacts as expected (including breaking the links when creating the output file).
However, if I just run the macro from the button on the "Control" sheet, it fails on this line:-
Code:
wb.BreakLink Name:=break_link_name, Type:=xlExcelLinks
Can anyone explain why or how I can reset the "On Error" so I get a proper error message if it fails?
Last edited: