Asp Forum
Home
|
Login
|
Register
|
Search
Forums
>
microsoft.public.excel.programming
Newbie Web Query and Date Formatting + Error Handling
AKTransplant
12/14/2006 7:39:00 PM
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.whatevercomesf...
& 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.whatevercomesf...
& 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 Answers
Dave Miller
12/14/2006 9:17:00 PM
0
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.whatevercomesf...
& 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.whatevercomesf...
& 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
AKTransplant
12/14/2006 9:56:00 PM
0
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
Don Guillett
12/14/2006 10:41:00 PM
0
Maybe?? you can find something here
http://tinyurl....
--
Don Guillett
SalesAid Software
dguillett1@austin.rr.com
"AKTransplant" <lance.stone@gmail.com> wrote in message
news:1166125145.256099.144720@73g2000cwn.googlegroups.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.whatevercomesf...
& 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.whatevercomesf...
& 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
>
Servizio di avviso nuovi messaggi
Ricevi direttamente nella tua mail i nuovi messaggi per
Newbie Web Query and Date Formatting + Error Handling
Inserendo la tua e-mail nella casella sotto, riceverai un avviso tramite posta elettronica ogni volta che il motore di ricerca troverà un nuovo messaggio per te
Il servizio è completamente GRATUITO!
x
Login to ForumsZone
Login with Google
Login with E-Mail & Password