Menu

Newbie Web Query and Date Formatting + Error Handling

Search this Thread

Prev

Previous Post

Next Post

Next

#4

Report Post

Posted to microsoft.public.excel.programming

Don Guillett Don Guillett is offline

Don Guillett is offline

external usenet poster

Posts: 10,124

Default

Newbie Web Query and Date Formatting + Error Handling

Maybe?? you can find something here
http://tinyurl.com/yhd6zy

--
Don Guillett
SalesAid Software

"AKTransplant" wrote in message
ups.com...
I have a project that seemed easy at first glance. Simply stated, I
want to insert a cropped and sized .PNG image from a website into my
worksheet at a predetermined location.

It wasn't that easy (I'm new at VBA, so bear with me). I started out
with little knowledge of VBA and my code is a Frankenstein collection
of recorded macros and cuts and pastes (mostly from this board). This
code does the following:

1. Clears all pictures on the active sheet for a clean slate
2. Adds a new worksheet (temp) to perform all the work of the macro
3. Change the date to now +9 hours (to construct the webquery URL)
4. Webquery the constructed URL and paste results to temp worksheet
5. Delete columns A:D of the query results (unneeded)
6. AutoFilter for all cells that end with a static text string (the
picture I need always ends with this string)
7. Copy Filter results to bottom of worksheet (just to get them out of
the way for now)
8. Delete Range containing WebQuery results
9. Sort filter results in descending order (the beginning of each cell
is a time in hhhhmmss (GMT) format so the most recent picture would end
up being sorted to the top in cell A1)
10. Open up Internet Explorer to URL constructed much like the
Webquery, but concatenating the value of cell A1 at the end of it.
11. SendKeys to Internet Explorer to:
a. Select All
b. Copy
c. Close
12. Paste Picture to cell A2
13. Crop and Size Picture
14. Copy Picture
15. Paste Picture back to Main Sheet
16. Move Picture to just the right spot
17. Delete "temp" sheet

I am still left with one problem: Error Handling. If my Webquery (step
4) tries to go to the current GMT day's URL and that URL hasn't been
created yet, I would like to turn back the clock in my code by one day
to pull the query info from the previous day's (GMT) URL. I would like
to do the same Error handling when I create the URL in step 10 above.

Finally, I'm willing to bet that there's an easier/more elegant way to
do all of this. Any ideas would be greatly appreciated. Here's the
code (URLs have been changed to protect the innocent):

Sub SurfaceChart()
'
' SurfaceChart Macro
' Macro recorded 12/7/2006 by
'
ActiveSheet.Pictures.Delete
Worksheets.add
ActiveSheet.Name = "temp"
Dim I As Date
I = Now() + 0.375
With ActiveSheet.QueryTables.add(Connection:= _
"URL;https://www.whatevercomesfirst" & Format(I, "yyyymm") &
"/" & Format(I, "dd") & "/ANALYSIS/ALASKA", _
Destination:=Range("A1"))
.Name = "ALASKA_5"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Columns("A:D").Select
Selection.Delete Shift:=xlToLeft
Rows("1:2").Select
Selection.Delete Shift:=xlUp

Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:= _
"=*_MY_PICTURE_ALWAYS_ENDS_WITH_THIS.PNG", Operator:=xlAnd

If ActiveSheet.AutoFilterMode Then
Set rng = ActiveSheet.AutoFilter.Range
rng.Copy Destination:=Worksheets("temp").Range("A500")
Debug.Print rng.Address
Else
MsgBox "No filter in place"
End If
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:= _
"=*_MY_PICTURE_ALWAYS_ENDS_WITH_THIS.PNG", Operator:=xlAnd
Selection.AutoFilter
Rows("1:500").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

ActiveWorkbook.FollowHyperlink
Address:="https://www.whatevercomesfirst" & Format(I, "yyyymm") & "/" &
Format(I, "dd") & "/ANALYSIS/ALASKA/" & Range("A1").Value
SendKeys ("%E"), True
SendKeys ("A"), True
SendKeys ("%E"), True
SendKeys ("C"), True
SendKeys ("%{F4}"), True

Range("A2").Select
ActiveSheet.Paste

ActiveSheet.Shapes("Picture 6").Select
Selection.ShapeRange.PictureFormat.CropTop = 132#
Selection.ShapeRange.PictureFormat.CropRight = 191.37
Selection.ShapeRange.PictureFormat.CropLeft = 203.39
Selection.ShapeRange.PictureFormat.CropBottom = 201.75
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 190.5
Selection.ShapeRange.Width = 227.25
Selection.ShapeRange.Rotation = 0#
Selection.Copy
Sheets("MEF Worksheet").Select
Range("H3").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -0.75
Selection.ShapeRange.IncrementTop -11.25
Application.DisplayAlerts = False
Sheets("temp").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Range("A3:G17").Select

End Sub

Any help is greatly appreciated. Thanks in advance

Reply With Quote

Reply With Quote

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Posting Rules
Smilies are On [IMG] code is On HTML code is Off Trackbacks are On Pingbacks are On Refbacks are On

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
error handling date	Arnold Klapheck	Excel Programming	1	August 29th 06 10:38 PM
Error Handling - On Error GoTo doesn't trap error successfully	David	Excel Programming	9	February 16th 06 05:59 PM
Error handling with a handling routine	ben	Excel Programming	0	March 15th 05 03:01 PM
Newbie Q: Error handling procedures in a loop	KR	Excel Programming	2	March 4th 05 05:51 PM
Error Handling Open Function or query for missing Files	BigNate	Excel Programming	3	June 11th 04 05:22 PM

All times are GMT +1. The time now is 07:16 AM.

About Us

"It's about Microsoft Excel"

Contact Us ExcelBanter forum home Privacy Statement