I have a vba, that gets a URL. The URL (if inserts into a browser) downloads a .csv file.
The vba should get the data of that .csv file from the URL, and it adds the data to a new sheet.
This is the code that have to connect to the URL and get the data:
With Sheets(currentSymbol).QueryTables.Add(Connection:= _
"TEXT;" & URL _
, 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
If I use the following URL (that returns a .csv file), it works fine:
http://www.google.com/finance/historical?q=SPY&startdate=Jan+1%2C+2000&enddate=Dec+31%2C+2017&num=30&ei=WLQtWaAfiMOxAbeYutgE&output=csv
But if I use the following URL (which also returns a .csv file), I get an exception:
https://query1.finance.yahoo.com/v7/finance/download/SPY?period1=1476219600&period2=1508533200&interval=1d&events=history&crumb=uqY5qLCvV0S
CurrentSymbol and dataAddress in both cases is the same.
URL holds the url.
The second URL does exists and does return a .csv file.
I have a pre-check for the URL that completes fine (for both the URLs):
Function HttpExists(sURL As String) As Boolean
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.ServerXMLHTTP")
On Error GoTo haveError
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = IIf(oXHTTP.status = 200, True, False)
Exit Function
The exception that I get from the second URL says:
Error 1004: Microsoft excel cannot access the file "https://.........."
There are several posible reasons:
* The file name of path does not exist
* The file is being used by another program
* The workbook you are trying to save the same name as a currently open workbook
What can be the problem with the second URL?
Why do I get the exception for the second URL?
Thanks
The second URL only returns a .csv file when your browser has the right cookie. Excel probably can't provide cookie, so it gets a warning in JSON.
Related
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'm trying to automate a process that where in a folder there are 50+ tsv files. They have to be opened via notepad++ and save it as .txt file in the same folder.
Using the below code i'm opening the tsv file in notepad++.
MyTxtFile = Shell("C:\Program Files (x86)\Notepad++\notepad++.exe I:\Test\Sample.tsv", 1)
However, i have no idea how to save it as txt file by using VBA. Is it doable? If yes kindly teach me how.
Thank you in advance :)
If you only want to rename the files from *.tsv to *.txt you could use the command line
ren *.tsv *.txt
Finally found a remedy by exporting via Data => From Text option the above issue can be tackled..
Below is code for the same..
Do While fname <> ""
Workbooks.Add
Set wBook = ActiveWorkbook
Set wksht = ActiveSheet
With wksht.QueryTables.Add(Connection:="TEXT;" & folder_name & fname, Destination:=Range("$A$1"))
.Name = fname
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
There is another thread which touched upon the general aspect of calling shell commands. Maybe it can be of help to you:
Execute a command in command prompt using excel VBA
I know that this post is going to seem very similar to many other posts to those who understand it. I have learned C++ and C#, both only well enough to do minor work, and I just cannot understand VBA well enough to make this macro happen.
I have just under 100 files that need to be imported to a master file. I cannot modify the source files but the master file needs only select columns.
This macro works almost perfectly I just need the ability to select new file paths for each instance of the macro being used. I have found many posts that seem to use something like this:
https://social.msdn.microsoft.com/Forums/office/en-US/231cbfc5-95ad-4673-a20c-f87355c6bc5e/prompt-user-for-file-name-to-import-as-fixed-width-text-file?forum=exceldev
in order to first make a filepath into a variable and then pass it to the ActiveSheet.QueryTables.Add command. I might just be missing something but there are a lot of variables between all of the examples that I just don't understand. It seems like the msdn page for vba is much less intuitive than those for C#. Either that or I am simply unable to understand them having not taken the babysteps that I need.
Using the macro tool I made the large majority of the code below. About an hour of working allowed me to replace the hardcoded cell with the active cell.
Sub InputDataFromTextFile()
'
' InputDataFromTextFile Macro
'
' Keyboard Shortcut: Ctrl+t
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;E:\Dropbox\College 2016-2017\Research\Buffered Solutions\pH10\With PDADMAC\30.CSV" _
, Destination:=ActiveCell)
.Name = "30"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 1, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
I would appreciate any and all help that could be given. Thank you all so much for your time regardless.
So immediately after posting, I hadn't figured it out in the comments I tried something and got it to work. Here is the code as it stands.
Sub InputDataFromTextFile()
Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim FileName As Variant
' Set up list of file filters
Filt = "All Files (*.*),*.*"
' Display Text Files by default
FilterIndex = 1
' Set the dialog box caption
Title = "Select a File to Import"
' Get the file name
FileName = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Title)
' Exit if dialog box is canceled
If FileName = False Then
MsgBox "No file was selected."
Exit Sub
End If
'
' InputDataFromTextFile Macro
'
' Keyboard Shortcut: Ctrl+t
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & FileName, _
Destination:=ActiveCell)
.Name = "30"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 1, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
One of my largest issues was honestly that once excel was restarted the Ctrl+T that I had hotkeyed to the command reverted to making a table. I couldn't figure out where it was coming from! Thank you for your help. This saves me a great deal of time.
While the comment made by Parfait about cycling through the files and having them auto import is the next step and a very obviously desired trait in the code, it seems like a lot for me right now. I'm already saving upwards of an hour per mastersheet which is just amazing. Thank you all so much again.
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 am importing multiple csv files from Google Finance and saving the data to a single worksheet. Whenever a URL is not valid I would like it to go to an error handler where it essentially says "this info could not be found" and then continue back to grab the next csv file from the web.
The code works fine UNTIL it gets to an invalid url, and executes the error handler. The error handler does its job the first time, but then when the loop continues with a new URL, it errors again even when the url is valid.
Once the querytable .Refresh errors once, each url after will also error even if it is a valid url. Is there a way to clear the error and move on to the next URL?
Code:
Sub getQuotes()
For i = 1 To 3775
sym = Worksheets("2").Range("C" & i)
lookup = "TEXT;http://www.google.com/finance/historical?q=" + sym + "&startdate=Jun+1%2C+2016&enddate=Aug+5%2C+2016&num=30&authuser=1&output=csv"
With Worksheets("Raw Data").QueryTables.Add(Connection:=lookup, Destination:=Worksheets("Raw Data").Range("A2"))
.Name = _
" "
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 775
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileDecimalSeparator = ","
.TextFileTrailingMinusNumbers = True
On Error GoTo Err1:
.Refresh BackgroundQuery:=True
End With
Next
Err1:
Worksheets("Raw Data").Range("A:F").EntireColumn.Insert
Worksheets("Raw Data").Range("A2") = sym + " data could not be extracted"
Resume Next
End Sub
Although I was not able to reproduce the specific problem you've referenced, you're missing Exit Sub before your Error handling section. Without it, the code under Err1: gets executed after your For loop finishes, regardless of whether there was an error.
Simply add Exit Sub on the line above your Err1: and let 'er rip. My code worked with an error in the middle of my sym list with this change.