Sub Macro1()
Dim URL As String
Dim Path As String
Dim i As Integer
For i = 2 To 50
If Range("Prices!E" & i).Value <> 1 Then
URL = Range("Prices!D" & i).Text
Path = Range("Prices!F" & i).Text
End If
Sheet19.Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URL _
, Destination:=ActiveSheet.Range("$A$1"))
.Name = _
"" & Path
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
//'In the Line above the above
//'Run time error '1004
//'An unexpected error has occured
End With
Next i
End Sub
The code above creates an error at the specified line. A google search on .Refresh BackgroundQuery shows that it is picky in its functionality in loops. Simply deleting the line makes nothing show up in excel.
With the current error message the code works fine for the first i value and then breaks.
For Answer and comments-
TLDR: .Refresh BackgroundQuery:=False will fail if your query input is invalid or malformed. The problem in this case was the for...next loop was calling cells to use as url's that hand no values in them. However it will fail anytime the query is malformed.
All the previous lines inside the With statement are setting properties.
the .Refresh BackgroundQuery := False is a method call.
The refresh is supposed to refresh the results.
The background Query is for when quering SQL data and is optional so I think you can leave it off and just have .Refresh
Query Table Refresh Method Help Link
Edit
It would appear that there is something wrong with the URL and when it goes to refresh it is unable to do it. could be a proxy issue, or not connected to the network, or the URL does not exist.
The only way to resolve this issue is to delete the active query table after each iteration. A useful example solution provides:
https://social.technet.microsoft.com/Forums/office/en-US/956dc1b6-bd37-4b97-a042-ba2a37f729b6/removing-querytables-and-leaving-the-results?forum=excel
I'm not sure why my fix worked, but here it is:
I also used querytables.add within a for loop, and I was adding .asc files. This error was only popping up after the last addition--so my program essentially did what I wanted it to, but it would interrupt function. On the last run through the For loop, I removed the .Refresh BackgroundQuery:=False statement. It was necessary for it to paste my data for all the previous runs through the For loop.
Basically I replaced this:
.Refresh BackgroundQuery:=False
With this:
If Index = ctr Then
Else
.Refresh BackgroundQuery:=False
End If
Related
I had some exceptional requirement. That is i have set of value which will come in the drop down in an Excel cell. While changing the value it will hit the server and fetch data according the drop down selected in the excel.
Finally i have done with some simple steps. Please find it following.
Step 1:- Create your drop down list
Go to Data -> Data validation
Now you have created a drop down in F2 cell as follows:
Now on change we have to create a macro which will fetch data from server:
Step 2 :-
Now you have to click on View Code which will open a code window. There you have to paste the following code.
Private Sub Worksheet_Change(ByVal Target As Range)
'MsgBox "You just changed " & Target.Address
If Target.Address = "$F$2" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.google.com/", Destination:= _
Range("A1"))
.Name = "MR07"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
End If
End Sub
In the above code you can replace your own URL instead of https://www.google.com/
A1 is the starting row of output, which is coming from server. $F$2 is validating the changes coming from drop down. if you not put this condition for all cell changes it will call this function which is not expected.
There is a website, that can create thousands of .csv files that contain tables. The CSV files are based on the information the user asks.
I created an excel file with VBA script. The user enters the data to the excel file, then the VBA script generates the correct URL, and tries to get the required data from the .csv in that URL.
In my excel file, the user can ask for hundreds of .csv tables, and I want the user to be able to enter the hundreds of information kinds he wants, then run the VBA script and leave the computer to work on it.
I first do URL check, and if it is ok, I try to get the data in the .csv file in that URL.
most of the times, it works completely fine. Works fine for a case when HttpExists returns TRUE, and also works fine for a case that HttpExists returns FALSE (it just skips the current active cell and goes to the next one).
But there are a few times, that the URL check answers that the URL is fine (HttpExists returns TRUE), but when it tried to get the data, it opens a message box that says "sorry, we couldn't open 'url address' ". (message box for Run Time Error 1004) and then the VBA scripts terminates.
I would like to know how can I fix it. How can I just skip the current URL in case of error, instead of showing a message box that terminates the script run?
Sub my_method()
On Error GoTo handleCancel
Dim errorFlag As Boolean
.......
Do Until ActiveCell.Value = ""
errorFlag = True
URLstring= ....
........
If Not HttpExists(URLstring) Then
symbolStatus = "Data unavailable"
logAddress = updateLog("invalid URL " & ActiveCell.Value, logAddress, debugString)
Application.DisplayAlerts = False
Sheets(currentSymbol).Delete
Application.DisplayAlerts = True
Else
With Sheets(currentSymbol).QueryTables.Add(Connection:= _
"TEXT;" & URLstring _
, Destination:=Sheets(currentSymbol).Range(dataAddress))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
.......
errorFlag = False
handleCancel:
ActiveCell.Offset(1, 0).Select
If errorFlag = True Then
symbolStatus = "Data unavailable"
logAddress = updateLog("invalid URL " & ActiveCell.Value,
logAddress, debugString)
Application.DisplayAlerts = False
Sheets(currentSymbol).Delete
Application.DisplayAlerts = True
End If
Loop
End Sub
Function HttpExists(sURL As String) As Boolean
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.ServerXMLHTTP")
If Not UCase(sURL) Like "HTTP:*" Then
sURL = "http://" & sURL
End If
On Error GoTo haveError
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = IIf(oXHTTP.status = 200, True, False)
Exit Function
haveError:
HttpExists = False
End Function
It sometimes goes out with a messagebox of Run Time Error 1004, and it happens in the line of:
With Sheets(currentSymbol).QueryTables.Add(Connection:= _
"TEXT;" & URL _
I would like it just to skip the current cell in a case of error, and go on with the next cell, without any messagebox and without crashing.
How can I fix it?
Thanks
See if this error handling structure works better. I eliminated parts that are unnecessary and adjusted to what should work, but I am not sure what code is in the ..... sections. Anyway, this should at least give you a general understanding. I commented a few things to explain more clearly in code.
Option Explicit
Sub my_method()
Do Until ActiveCell.Value = ""
'URLstring= ....
If Not HttpExists(URLstring) Then
LogError 'create sub since you do same thing twice
Else
On Error GoTo handleBadURL 'now is only time you need to move to actual error handling
With Sheets(currentSymbol).QueryTables.Add(Connection:= _
"TEXT;" & URLstring _
, Destination:=Sheets(currentSymbol).Range(dataAddress))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
On Error Go To 0 'reset error handling (doesn't matter so much here, but good practice to always reset when not needed
End If
ActiveCell.Offset(1, 0).Select
Loop
Exit Sub 'leave sub when all is done (so it doesn't move to error handling code below
handleBadURL:
LogError 'created sub since you do same thing twice
Resume Next 'this statement will allow code to continue from point of error onward (the loop will keep going
End Sub
Sub LogError()
symbolStatus = "Data unavailable"
logAddress = updateLog("invalid URL " & ActiveCell.Value, logAddress, debugString)
Application.DisplayAlerts = False
Sheets(currentSymbol).Delete
Application.DisplayAlerts = True
End Sub
You need to add error handling to your code. Server timeout notices doesn't reflect an issue with your coding, but an issue with the server (which is out of your control, unless of course, you entered an incorrect URL).
In your code, you need to place On Error GoTo ErrHandler, make sure you have the error number, and since you are wanting to just resume to the next cell you can do something like this:
Sub Test()
On Error GoTo ErrHandler
'Your code
Exit Sub
ErrHandler:
If Err.Number = 123456 Then
'Get the code ready for the next cell, if necessary
Resume Next
Else
'Other Errs
End If
End Sub
I had a question about how to retrieve the contents of a final URL in Microsoft excel, using their Visual BASIC macros.
Essentially, I have a list (ListA) full of URLs. I have code written to trawl every URL on List A one by one and retrieve the data I need, putting it into Excel.
However, a certain percentage of the URLs redirect to 404 pages. I do not have any way of knowing which ones these will be in advance currently, and am trying to write a script that will simply:
1.) Access the URL in ListA
2.) Copy the destination URL that it redirects to
3.) Paste that URL into the cell directly to the right of the original URL
That way I can see what the final URLs are, and if any go to a 404 page, I can delete them from the list before attempting to trawl it for the info I need.
I have had no luck in doing so thus far, and every tutorial I can find online seems to feature code that will not work in Microsoft Excel's limited environment. Does anyone have any idea where I should start?
If it helps, here is the code I have written to trawl the webpage for data:
For i = 1 To 500
ThisURL = "URL;" & WSD.Cells(i, 2)
ThisParcel = "P" & WSD.Cells(i, 1)
Set WSW = Worksheets.Add(After:=Worksheets(Worksheets.Count))
WSW.Name = ThisParcel
WSW.Select
' Do a web query here
With ActiveSheet.QueryTables.Add(Connection:= ThisURL, Destination:=Range("$A$1"))
.Name = "Query" & i
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next i
I've recorded a macro to query a database, and when I record the macro, the query runs properly. However, when I try to run the macro again on the same sheet or on a different one, I get the error:
runtime error 1004, "SQL syntax error"
on the line
.Refresh BackgroundQuery:=False".
Below is the recorded macro.
Sub Macro3()
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=Substation Prod;SRVR=SUBP;UID=U326357;", Destination:=Range("A1"))
.CommandText = Array( _
"SELECT FACT_MONTHLY.TIME_STAMP, FACT_MONTHLY.SYSTEM_NUMBER_VAL0, FACT_MONTHLY.SUBSTATION_NUMBER_VAL0, FACT_MONTHLY.MVA_MAX_OUT_VAL0, FACT_MONTHLY.MW_MAX_OUT_VAL0, FACT_MONTHLY.MVAR_MAX_OUT_VAL0, FACT_" _
, _
"MONTHLY.MW_MIN_OUT_VAL0, FACT_MONTHLY.MVAR_MIN_OUT_VAL0, FACT_MONTHLY.PF_MAX_VAL0, FACT_MONTHLY.PF_MIN_VAL0, FACT_MONTHLY.TOP_OIL_TANK_MAX_VAL0, FACT_MONTHLY.LOAD_FACTOR_VAL0, FACT_MONTHLY.PH1_TAP_MAX" _
, _
"_DRAG_VAL0, FACT_MONTHLY.WIND_TEMP_MAX_VAL0, FACT_MONTHLY.LTC_TEMP_MAX_VAL0, FACT_MONTHLY.PH2_TAP_MAX_DRAG_VAL0, FACT_MONTHLY.PH3_TAP_MAX_DRAG_VAL0, FACT_MONTHLY.BOT_OIL_TEMP_MAX_VAL0, FACT_MONTHLY.PH" _
, _
"1_TAP_MIN_DRAG_VAL0, FACT_MONTHLY.PH2_TAP_MIN_DRAG_VAL0, FACT_MONTHLY.PH3_TAP_MIN_DRAG_VAL0, FACT_MONTHLY.PH1_LOAD_MAX_KV_VAL0, FACT_MONTHLY.PH2_LOAD_MAX_KV_VAL0, FACT_MONTHLY.PH3_LOAD_MAX_KV_VAL0, FA")
.Name = "Query from Substation Prod"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub
I've searched online for ways to fix this issue, but none of the other solutions I've found are working. Any help would be greatly appreciated.
All the previous lines inside the With statement are setting properties.
the
.Refresh BackgroundQuery := False
is a method call.
The refresh is supposed to refresh the results.
The background Query is for when quering SQL data and is optional so I think you can leave it off and just have .Refresh
For further assistance try VBA Excel QueryTables.add .Refresh BackgroundQuery Error
Sub Macro3()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://..." _
, Destination:=Range("Sheet6!$G$23"))
''// The line above fails with the error:
''// "Run-time error '-2147024809 (80070057)':
''// The destination range is not on the same worksheet
''// that the Query table is being created on."
.Name = _
"?tmp=toolbar_FlvTube_homepage&prt=..."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
The recorded macro fails as described in the comment.
You recorded the macro while Sheet 6 was active, but are now trying to run it on a different sheet. To run the macro for the current active sheet, simply change the code as follows:
Sub Macro3()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://..." _
, Destination:=ActiveSheet.Range("$G$23"))
...
End With
End Sub
Edit: (in response to comment):
I need to be able to paste the results of the query to a different sheet then the active one since the macro can be run at any time and must be paste to the same location everytime. Perhaps there is a way to change your active sheet with code?
The error happens when the two sheets are different, so if you want the magic to happen on a particular sheet, you should specify that sheet instead of using ActiveSheet. The following code would always place the QueryTable on Sheet6:
Sub Macro3()
With Sheet6.QueryTables.Add(Connection:= _
"URL;http://..." _
, Destination:=Sheet6.Range("$G$23"))
...
End With
End Sub