Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
Option Explicit 'GOOGLE HOTEL FINDER 'www.google.com/hotelfinder Const cWAITTIME As String = "0:00:05" Const NIGHTS As Integer = 1 Const RATING As Integer = 0 Public Function DownloadGHFFile(sURL As String, sPath As String) As Boolean 'Function that accepts a search URL as sURL and destination file path as sPath 'Returns TRUE if file is written, FALSE if file is not written DownloadGHFFile = False 'Default as fail On Error GoTo exitSub 'Handle error and return false Dim oXHTTP As Object, oStream As Object, sTime As Date Dim iXHTTP As MSXML2.XMLHTTP60 'Create object and get page Set iXHTTP = New MSXML2.XMLHTTP60 With iXHTTP .Open "GET", sURL, False .send End With sTime = Now 'Mark time for timer Do Until iXHTTP.Status = 200 'If takes more than wait period, cancel (200 = ready) Debug.Print iXHTTP.Status If Now > sTime + TimeValue(cWAITTIME) Or iXHTTP.Status = 404 Then GoTo exitSub DoEvents Loop 'Write to file Set oStream = CreateObject("ADODB.Stream") With oStream .Type = 1 'adTypeBinary .Open .Write iXHTTP.responseBody .SaveToFile sPath, adSaveCreateOverWrite .Close End With DownloadGHFFile = True 'Mark as success exitSub: Set oXHTTP = Nothing Set oStream = Nothing End Function Public Function createGHFQuery(City As String, State As String, sDate As Date, Nts As Integer) As String 'Function to create url in google.com/hotelfinder format 'Returns string containing url Dim S As String, s2 As String S = "http://www.google.com/hotelfinder/" S = S & "#search;" s2 = "l=" & LCase(City) & ",+" & LCase(State) & ";" S = S & s2 s2 = "d=" & Format(sDate, "YYYY-MM-DD") & ";" S = S & s2 s2 = "n=" & Nts & ";" S = S & s2 s2 = "r=" & RATING S = S & s2 createGHFQuery = S End Function Sub test() 'Routine testing above functions Dim myS As String myS = createGHFQuery("Lahaina", "HI", CDate("10/15/2011"), NIGHTS) If DownloadGHFFile(myS, "C:\VBA Training\Web Source Files\googTest.txt") Then Call MsgBox("Success") Else Call MsgBox("Failed") End If End Sub
|Copy worksheets to new workbook without formulas referencing the old workbook||8||50|
|Trying to fix NUMBER ARRANGE Button to load faster and more efficiently.||20||23|
|Sum based on custom date ranges||4||25|
|Merge two cells into one cell in Excel 2013||6||25|
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
19 Experts available now in Live!