| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Newbie Web Query and Date Formatting + Error Handling
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Newbie Web Query and Date Formatting + Error Handling
That is a mess, and I am afraid I can not help you without the correct
url. AKTransplant wrote: 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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Newbie Web Query and Date Formatting + Error Handling
I agree that it's a mess, I'm admittedly new at this. The url is on my
intranet, so probably not very helpful. Thanks for trying |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| error handling date | Excel Programming | |||
| Error Handling - On Error GoTo doesn't trap error successfully | Excel Programming | |||
| Error handling with a handling routine | Excel Programming | |||
| Newbie Q: Error handling procedures in a loop | Excel Programming | |||
| Error Handling Open Function or query for missing Files | Excel Programming | |||
Linear Mode
