Results 1 to 7 of 7

Thread: [RESOLVED] Saving Web Page Images In Temp Folder!

  1. #1

    Thread Starter
    Frenzied Member arpan_de's Avatar
    Join Date
    Oct 2005
    Location
    Mumbai, India
    Posts
    1,394

    Resolved [RESOLVED] Saving Web Page Images In Temp Folder!

    Using the WebBrowser control, the following code ought to save 'all' images existing in a web page in the user's hard disk (please note that this isn't my code):
    VB Code:
    1. Option Explicit
    2. ' Use component M$ HTML Object Library
    3. Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    4.  
    5. Private Function [b]GetFile(URL As String) As String[/b]
    6.     'Purpose: returns file title of a URL or local path
    7.     GetFile = Right$(URL, Len(URL) - InStrRev(URL, "/"))
    8. End Function
    9.  
    10. Private Sub [b]Form_Load()[/b]
    11.     WebBrowser1.Navigate2 "http://www.yahoo.com"
    12.    
    13.     Dim objDoc1 As HTMLDocument
    14.     Dim objDoc2 As HTMLDocument
    15.     Dim i As Integer
    16.    
    17.     Set objDoc1 = New HTMLDocument
    18.    
    19.     'Create document element from url
    20.     Set objDoc2 = objDoc1.createDocumentFromUrl("http://www.yahoo.com", "")
    21.    
    22.     'Wait till document has loaded
    23.     Do While objDoc2.readyState <> "interactive"
    24.         DoEvents
    25.     Loop
    26.    
    27.     'Loop through images
    28.     For i = 0 To objDoc2.images.length - 1
    29.         'download images and save them in app.path
    30.         URLDownloadToFile 0, objDoc2.images.Item(i).href, App.Path & "\" & GetFile(objDoc2.images.Item(i).href), 0, 0
    31.         'MsgBox i
    32.     Next i
    33.    
    34.     Set objDoc1 = Nothing
    35.     Set objDoc2 = Nothing
    36.     Beep
    37. End Sub
    There are 2 problems with this code. First, not all the images get saved in the user's hard disk. For e.g. if you navigate to www.yahoo.com, under normal circumstances, 18 images will be saved in IE's Temporary Internet Files folder but the above code only saves 7 images in the folder specified in the code. Any idea how do I overcome this?

    Secondly, have a look at the DoEvents line. Because of this line, it takes about 4-5 seconds for the browser to open up but if the DoEvents line is commented, then the browser opens up in a jiffy but not a single image gets saved in the specified folder. Any idea how do I make the above code work without using DoEvents?

    BTW, what does the Beep in the above code do?

    Thanks,

    Arpan
    Last edited by arpan_de; Dec 5th, 2005 at 08:06 PM.

  2. #2
    Hyperactive Member eranfox's Avatar
    Join Date
    May 2001
    Posts
    492

    Re: Someone Please Help!

    Hello arpan_de,
    Try to change this:
    VB Code:
    1. Do While objDoc2.readyState <> "interactive"
    2.         DoEvents
    3.     Loop
    to this:
    VB Code:
    1. DoEvents
    2.     Do While objDoc2.readyState <> "interactive"
    3.     Loop

    The Beep is just to Sound a tone through the computer's speaker
    ...maybe to let you know the proccess is done...

    Best Regards,
    ERAN
    Eran Fox
    ASSEMBLER,C,C++,VB6,SQL...

  3. #3
    PoorPoster iPrank's Avatar
    Join Date
    Oct 2005
    Location
    In a black hole
    Posts
    2,729

    Save images from Webbrowser

    I've slightly modified your code, and it seems to work.
    I have used DocumentComplete event instead if a waiting loop.
    VB Code:
    1. 'Place this code in a form and add a WebBrowser Control and a Command button
    2. Option Explicit
    3.  
    4. Private Declare Function URLDownloadToFile Lib "urlmon" _
    5.    Alias "URLDownloadToFileA" _
    6.    (ByVal pCaller As Long, _
    7.    ByVal szURL As String, _
    8.    ByVal szFileName As String, _
    9.    ByVal dwReserved As Long, _
    10.    ByVal lpfnCB As Long) As Long
    11.  
    12. '======================================================================
    13. Private Sub Form_Load()
    14.    
    15.   WebBrowser1.Navigate "about:blank"
    16.    
    17. End Sub
    18.  
    19. '======================================================================
    20. Private Sub Command1_Click()
    21.  
    22.   WebBrowser1.Navigate "http://www.yahoo.com"
    23.  
    24. End Sub
    25.  
    26. '======================================================================
    27.  
    28. Private Function GetFile(URL As String) As String
    29.  
    30.   'Purpose: returns file title of a URL or local path
    31.   GetFile = Right$(URL, Len(URL) - InStrRev(URL, "/"))
    32.  
    33. End Function
    34.  
    35. '======================================================================
    36. Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, _
    37.      URL As Variant)
    38.  
    39.   'Wait till document has loaded
    40.    
    41.   Dim i As Integer
    42.   Dim strImageFileName As String 'stores ONLY the filename of the image
    43.   Dim strImageAddress As String 'stores the address of the image
    44.    
    45.   'Loop through images
    46.  
    47.   For i = 0 To WebBrowser1.Document.Images.length - 1
    48.        
    49.     strImageAddress = WebBrowser1.Document.Images.Item(i).src
    50.     strImageFileName = GetFile(strImageAddress)
    51.    
    52.     'Download images and save them in app.path --->
    53.     URLDownloadToFile 0, strImageAddress, App.Path & "\" & strImageFileName, 0, 0
    54.    
    55.   Next i
    56.  
    57. End Sub
    58. '======================================================================
    Last edited by iPrank; Apr 6th, 2006 at 12:06 AM. Reason: Re-formatted code
    Usefull VBF Threads/Posts I Found . My flickr page .
    "I love being married. It's so great to find that one special person you want to annoy for the rest of your life." - Rita Rudner


  4. #4

    Thread Starter
    Frenzied Member arpan_de's Avatar
    Join Date
    Oct 2005
    Location
    Mumbai, India
    Posts
    1,394

    Re: Someone Please Help!

    Thanks, mates, for your help. This is how I finally did it:
    VB Code:
    1. Private Sub [b]wWeb_DocumentComplete(ByVal pDisp As Object, URL As Variant)[/b]
    2.     Dim TempFolder
    3.     Dim collImages As IHTMLElementCollection
    4.     Dim img As IHTMLImgElement
    5.     Dim strFileName As String
    6.     Dim strExtension As String
    7.     Dim lResult As Long
    8.     Dim i As Long
    9.     Dim nAnomalies As Long
    10.    
    11.     TempFolder = App.Path & "\Temp Files\"
    12.    
    13.     Set collImages = pDisp.Document.getElementsByTagName("IMG")
    14.    
    15.     For i = 0 To collImages.Length - 1
    16.         Set img = collImages.Item(i)
    17.         strFileName = Right(img.src, Len(img.src) - InStrRev(img.src, "/"))
    18.         strExtension = LCase(Right(strFileName, Len(strFileName) - InStrRev(strFileName, ".")))
    19.         If (strExtension = "gif" Or strExtension = "jpg" Or strExtension = "jpeg" Or strExtension = "png") Then
    20.             lResult = URLDownloadToFile(0, img.src, TempFolder & strFileName, 0, 0)
    21.         Else
    22.             If (InStr(1, img.mimeType, "GIF", vbTextCompare)) Then
    23.                 lResult = URLDownloadToFile(0, img.src, TempFolder & "anomaly" & nAnomalies & ".gif", 0, 0)
    24.             ElseIf (InStr(1, img.mimeType, "JPG", vbTextCompare)) Then
    25.                 lResult = URLDownloadToFile(0, img.src, TempFolder & "anomaly" & nAnomalies & ".jpg", 0, 0)
    26.             End If
    27.         End If
    28.         Set img = Nothing
    29.     Next i
    30.     Set collImages = Nothing
    31. End Sub
    & this works fine. Got the code from Microsoft.

    Thanks once again,

    Regards,

    Arpan

  5. #5

    Thread Starter
    Frenzied Member arpan_de's Avatar
    Join Date
    Oct 2005
    Location
    Mumbai, India
    Posts
    1,394

    Re: [RESOLVED] Saving Web Page Images in Temp Folder!

    Arpan, could you please change the thread title, just for easier searching ?
    Oh! sure.........absolutely no problem.......

    Arpan

  6. #6
    Banned
    Join Date
    Mar 2008
    Posts
    24

    Re: [RESOLVED] Saving Web Page Images in Temp Folder!

    how can i use webbrowser...
    i just wanna to know how ppl get pic and save it as pic
    like

    here pic for expln

    http://brightdays.files.wordpress.co...-wilson-16.jpg

    webbrowser1.nvt("http://brightdays.files.wordpress.com/2007/08/owen-wilson-16.jpg")
    its goto the page
    i wanna to know how can i use it as img
    in webbrowser
    when i hit with webbrowser it show in frame just pic not all page...
    and its save as jpg img
    can someone expln me plsss

    Make 2 button
    and then jpg pic show it in frame when i hit the link and its save as pic

    thanks

  7. #7
    New Member
    Join Date
    Jan 2010
    Posts
    1

    Re: [RESOLVED] Saving Web Page Images In Temp Folder!

    I have one possible answer to this problem. This code downloads webpage and saves both html and image files. Hope it helps.
    vb Code:
    1. 'Code generated by Marcelo Boczko
    2. ' Date: 2010/01/06
    3. ' This code saves Webpage (.html file) and pictures. Pay attention to path of the files
    4.  
    5. Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    6. Private Declare Function GetDesktopWindow Lib "user32" () As Long
    7.  
    8. Private Sub CommandButton1_Click()
    9.     If TextBox2.Text <> "" Then
    10.         Call SaveWebPage(TextBox1, TextBox2)    'passing Path and Archive name
    11.     End If
    12. End Sub
    13.  
    14. Private Sub SaveWebPage(sURLPath As String, sURLArchive As String)
    15.     'Saving text information (.html file)
    16.     Dim Scr_hDC As Long
    17.     Scr_hDC = GetDesktopWindow()
    18.    
    19.     Label2.Caption = "Loading WebPage...     ( " & sURLArchive & " )"
    20.    
    21.     'WebBrowser1 is a WebBrowser control, enabled when some Tools/References are enabled:
    22.     ' - Microsoft HTML Object Library
    23.     ' - Microsoft Internet Controls
    24.     'Include WebBrower1 at your form
    25.     WebBrowser1.navigate (sURLPath & "/" & sURLArchive)
    26.     Dim e As IHTMLElement
    27.     Dim txtTemp As String
    28.     Dim iAux1 As Integer, iAux2 As Integer
    29.    
    30.     Open ThisWorkbook.Path & "/" & sURLArchive For Output As #1
    31.    
    32.     'Waiting till webpage loaded
    33.     Start = Now()
    34.     Do
    35.         DoEvents
    36.     Loop While WebBrowser1.readyState <> READYSTATE_COMPLETE
    37.  
    38.     Label2.Caption = "Saving Text"
    39.     'Saving text
    40.     For Each e In WebBrowser1.document.All
    41.         If e.innerHTML <> "" Then   'Any condition to choose which part of the page to save
    42.             txtTemp = e.innerHTML
    43.             Print #1, txtTemp
    44.             Exit For
    45.         End If
    46.     Next
    47.     Close #1
    48.  
    49. 'Saving images
    50.     Label2.Caption = "Saving Images"
    51. Dim tmp_imageName As String
    52. Dim HTML_img_element As MSHTML.HTMLImg
    53. Dim strFolder As String, strImageName As String, iCounter As Integer
    54.     For Each HTML_img_element In WebBrowser1.document.images
    55.         'this following line is to discover name of the file, it may change according to the webpage structure
    56.         tmp_imageName = Mid(HTML_img_element.src, InStr(1, HTML_img_element.src, "/images/", vbTextCompare) + 8)
    57.         If InStr(1, txtTemp, tmp_imageName, vbTextCompare) Then
    58.             'Finding where starts the name of the picture
    59.             For iCounter = Len(tmp_imageName) To 1 Step -1
    60.                 If InStr(iCounter, tmp_imageName, "/", vbTextCompare) Then
    61.                     Exit For
    62.                 End If
    63.             Next
    64.             strImageName = Mid(tmp_imageName, iCounter + 1)
    65.            
    66.             If iCounter = 0 Then iCounter = 1
    67.             Label2.Caption = "Saving Images to /images/" & Left(tmp_imageName, iCounter - 1)
    68.             strFolder = Left(tmp_imageName, iCounter - 1)
    69.             'Path to save image
    70.             strFolder = ThisWorkbook.Path & "/images/" & strFolder
    71.             URLDownloadToFile 0, HTML_img_element.href, strFolder & "/" & strImageName, 0, 0
    72.         End If
    73.     Next
    74.     Label2.Caption = "idle       ---> File  " & sURLArchive & "  sucessfuly saved."
    75. End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width