Solved

HELP- Resubmission--VBA Code for Downloading a jpg from internet to local file is not working

Posted on 2012-03-29
22
348 Views
Last Modified: 2012-04-04
Hi
  I have VBA code that works well with xp and vista, but not with windows 7. I have a routine that downloads a jpeg file from the internet and stores to a local location, then inserts the jpeg into a database feild (part of a workorder profile).

This is an access 2002 runtime mde front end with a sqlserver express 2005 backend.

When capturing the jpeg, it works fine the first time. But when the jpeg is edited and refreshed via a remote location, Access will download the previous version; not the updated version. BUT when the access app is closed and reopened, it inserts the proper jpeg (about 14 kilobytes in size).

I don't know what is happening. I don't know why it behaves this way. I have used three variations of code and they all behave the same way. I will list 2 of them:

1:

B = DownloadFile(UrlFileName:=URL, _
                        DestinationFileName:=LocalFileName, _
                        Overwrite:=OverwriteKill, _
                        ErrorText:=ErrorText)
       
        If B = True Then
            Debug.Print "Download successful"
          MsgBox "Download successful"
      Else
            Debug.Print "Download unsuccessful: " & ErrorText
             MsgBox "Download unsuccessful: Try Again" & ErrorText
        End If
2:

Dim WinHttpReq As Object
Dim oStream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.ResponseBody
    oStream.SaveToFile (LocalFileName)
    oStream.Close
End If

Set WinHttpReq = Nothing
Set oStream = Nothing

I was wondering if I was missing anything.

In the code, I also open 2 instance of internet explorer and refresh that site just in case.
(it is done twice- this resolved the same problem in vista and windows xp os)

Any help would be greatly appreciated. NEED HELP NOW...

Thanks
Frank
0
Comment
Question by:fsrebot
  • 13
  • 8
22 Comments
 
LVL 33

Expert Comment

by:Norie
Comment Utility
Frank

Where's the code for the function DownloadFile that's called in 1) ?
0
 

Author Comment

by:fsrebot
Comment Utility
Here it is..

             LocalFileName = "C:\Serv2000REMOTE\sig.jpg"
        B = DownloadFile(UrlFileName:=URL, _
                        DestinationFileName:=LocalFileName, _
                        Overwrite:=OverwriteKill, _
                        ErrorText:=ErrorText)
       

       If B = True Then
            Debug.Print "Download successful"
           MsgBox "Download successful"
       Else
            Debug.Print "Download unsuccessful: " & ErrorText
             MsgBox "Download unsuccessful: Try Again" & ErrorText
        End If

Thanks...
0
 
LVL 33

Expert Comment

by:Norie
Comment Utility
There's a function/sub called DownloadFile that you've not posted.

This is where it's used.
B = DownloadFile(UrlFileName:=URL, _
                        DestinationFileName:=LocalFileName, _
                        Overwrite:=OverwriteKill, _
                        ErrorText:=ErrorText)

Open in new window

0
 

Author Comment

by:fsrebot
Comment Utility
I am assuming it's a built in function.
This software works in windows xp.
Is something missing?

Thanks
Frank
0
 
LVL 29

Expert Comment

by:IrogSinta
Comment Utility
If you right click on "DownloadFile" and then click on Definition, it should take you to the function.
0
 

Author Comment

by:fsrebot
Comment Utility
Here is the code for the DownloadFile' Function:

Option Compare Database

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modDownloadFile
' By Chip Pearson, chip@cpearson.com, www.cpearson.com/Excel/DownloadFile.aspx
' Date: 23-April-2003
' This module contains the DownloadFile function and supporting players to
' download a file from a URL to a local file name.
'
' Example Usage:
'
'        Dim URL As String
'        Dim LocalFileName As String
'        Dim B As Boolean
'        Dim ErrorText As String
'
'        URL = "http://www.cpearson.com/Zips/FindAll.zip"
'        LocalFileName = "C:\Test\FindAll.zip"
'        B = DownloadFile(UrlFileName:=URL, _
'                        DestinationFileName:=LocalFileName, _
'                        Overwrite:=OverwriteKill, _
'                        ErrorText:=ErrorText)
'        If B = True Then
'            Debug.Print "Download successful"
'        Else
'            Debug.Print "Download unsuccessful: " & ErrorText
'        End If
'
' The Overwrite parameter of DownloadFile indicates how to handle the
' case when LocalFileName already exists. It is one of the following
' values:
'        OverwriteKill      use Kill to delete the existing file.
'        OverwriteRecycle   send the existing file to the Recycle Bin.
'        DoNotOverwrite     do not overwrite and terminate the procedure.
'        PromptUser         prompt the user asking whether to overwrite file.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Enum DownloadFileDisposition
    OverwriteKill = 0
    OverwriteRecycle = 1
    DoNotOverwrite = 2
    PromptUser = 3
End Enum

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API functions, constants,and types.
' Used for RecycleFile.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" _
    Alias "PathIsNetworkPathA" ( _
    ByVal pszPath As String) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" _
    Alias "GetSystemDirectoryA" ( _
    ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long

Private Declare Function SHEmptyRecycleBin _
    Lib "shell32" Alias "SHEmptyRecycleBinA" _
    (ByVal hwnd As Long, _
     ByVal pszRootPath As String, _
     ByVal dwFlags As Long) As Long

Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const MAX_PATH As Long = 260

Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

'''''''''''''''''''''''''''
' Download API function.
''''''''''''''''''''''''''''''''''''''
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



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DownloadFile
' This downloads a file from a URL to a local filename.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function DownloadFile(UrlFileName As String, _
                            DestinationFileName As String, _
                            Overwrite As DownloadFileDisposition, _
                            ErrorText As String) As Boolean

Dim Disp As DownloadFileDisposition
Dim Res As VbMsgBoxResult
Dim B As Boolean
Dim S As String
Dim L As Long

ErrorText = vbNullString

If Dir(DestinationFileName, vbNormal) <> vbNullString Then
    Select Case Overwrite
        Case OverwriteKill
            On Error Resume Next
            err.Clear
            Kill DestinationFileName
            If err.Number <> 0 Then
                ErrorText = "Error Kill'ing file '" & DestinationFileName & "'." & vbCrLf & err.Description
                DownloadFile = False
                Exit Function
            End If
   
        Case OverwriteRecycle
            On Error Resume Next
            err.Clear
            B = RecycleFileOrFolder(DestinationFileName)
            If B = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & err.Description
                DownloadFile = False
                Exit Function
            End If
       
        Case DoNotOverwrite
            DownloadFile = False
            ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
            Exit Function
           
        'Case PromptUser
        Case Else
            S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
                "Do you want to overwrite the existing file?"
            Res = MsgBox(S, vbYesNo, "Download File")
            If Res = vbNo Then
                ErrorText = "User selected not to overwrite existing file."
                DownloadFile = False
                Exit Function
            End If
            B = RecycleFileOrFolder(DestinationFileName)
            If B = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & err.Description
                DownloadFile = False
                Exit Function
            End If
    End Select
End If

L = URLDownloadToFile(0&, UrlFileName, DestinationFileName, 0&, 0&)
If L = 0 Then
    DownloadFile = True
Else
    ErrorText = "Buffer length invalid or not enough memory."
    DownloadFile = False
End If
   
End Function
                           
Private Function RecycleFileOrFolder(FileSpec As String) As Boolean

    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long

    If (Dir(FileSpec, vbNormal) = vbNullString) And _
        (Dir(FileSpec, vbDirectory) = vbNullString) Then
        RecycleFileOrFolder = True
        Exit Function
    End If

    With FileOperation
        .wFunc = FO_DELETE
        .pFrom = FileSpec
        .fFlags = FOF_ALLOWUNDO
        ' Or
        .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
    End With

    lReturn = SHFileOperation(FileOperation)
    If lReturn = 0 Then
        RecycleFileOrFolder = True
    Else
        RecycleFileOrFolder = False
    End If
End Function
0
 
LVL 33

Expert Comment

by:Norie
Comment Utility
With that code you shouldn't need to open any instances of your browser to help download the file.

Do you know how/when the image is refreshed on the server?
0
 

Author Comment

by:fsrebot
Comment Utility
The image is refreshed almost instantly. I currently tried the system out without opening the instances of IE and it behaved the same way. That is:

With Access open it will downloand a current image (Image 1) and it views properly.

A new image is upload to the server (Image 2) with the same mapping profile.

Access attemps to download this image and the process is successful, but it displays Image 1 instead of Image 2.

I completely close the access application and reopen it and attemp to download the new image and Image 2 is successfully loaded.

This was done continuously. There were no recognized time delays when uploading.

For some reason, the access app will not recognize the new image with the same mapping while remaining open. I have to close and reopen.

When I upload the image and I check right away with another instance of IE, it shows the new image correctly in the browser, with the same mapping.

Any Ideas?

Thanks- All help is greatly appreciated.

Frank
0
 
LVL 33

Expert Comment

by:Norie
Comment Utility
Frank

How are you opening the image in Access?
0
 

Author Comment

by:fsrebot
Comment Utility
Th image is being opened in a bound object frame.

Also

The image is imbedded into a field using this code:

graphicB.Action = acOLECreateEmbed, from its local temporary location.

I was wondering if there was a way to clear the cached file before downloading?

Thanks
Frank
0
 

Author Comment

by:fsrebot
Comment Utility
Hi,

   I have narrowed down the problem to having to delete the temporay internet files. This was not an issue with windows XP (for some reason) but it is for vista and xp.

I got some code as follows but it did not work (on vista):

Const TEMPORARY_INTERNET_FILES = &H20&


Dim objShell
Dim objFolder
Dim objFolderItem
Dim objFSO
Dim strPath

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(TEMPORARY_INTERNET_FILES)
Set objFolderItem = objFolder.self
strPath = objFolderItem.path & "\*.*"

Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (strPath)

I was wondering if there was any other vba code you know of that would work. (i need it to work on windows 7 o/s as well).

Thanks. All help is greatly appreciated!

Frank
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 33

Expert Comment

by:Norie
Comment Utility
Frank

The code I was going to suggest was kind of like the code that's used in the DownloadFile function you were using - that's why I kept on asking
for the code.:)

Perhaps the problem is with where you are saving the file to.

You seem to be saving it to a temporary folder, is there a reason for that?
0
 

Author Comment

by:fsrebot
Comment Utility
Hi  imnorie,

    The way the process works is that I download a jpg from the web and store it in a temporary folder, then I imbed the graphic into an field as part of a workorder profile.

The imdedding code is:

graphicB.Action = acOLECreateEmbed

The download requires a local location to download so that is why a store it temporarily.

I don't know if you could download and imbed in a single or fewer actions.

But what I did discover, is when I changed the uploaded image, then I deleted all temporary files from the browser, and then imbedded the image into the access application, without closing it down, it works properly.

I am thinking perhaps I would need vba code to delete all temporary internet files (or at least all jpegs) so that it would force a current download from the web

or

maybe there is an automated process to open an instance of the current image in an instance of Intenet Explorer and delete all temporary internet files from there.

Any help is great!

Thanks again.

Frank
0
 
LVL 33

Expert Comment

by:Norie
Comment Utility
Frank

Are you creating this temporaruy folder?
0
 

Author Comment

by:fsrebot
Comment Utility
The folder w ascreated when the app is loaded.

It is not created during the uploading process (during runtime).

Thanks

Frank
0
 
LVL 33

Expert Comment

by:Norie
Comment Utility
What's the path for the temporary folder?

Does it change from machine to machine, OS to OS, user to user?
0
 

Author Comment

by:fsrebot
Comment Utility
No, its the same all the time

'c:\Serv2000REMOTE\sig.jpg'

Thanks

Frank
0
 

Author Comment

by:fsrebot
Comment Utility
Hi imnorie,

  I was wondering if you were familiar with this code? I reasearched that it could lead to a possible solution.

****

Option Compare Database

Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Private Declare Function InternetOpen Lib "Wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetReadFile Lib "Wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "Wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "Wininet.dll" (ByVal hInet As Long) As Integer


Public Sub openNewCache(sUrl As String)
 
  Dim hInternet, hSession, lngDataReturned As Long
  Dim iReadFileResult As Integer
  Dim sBuffer As String * 128
  Dim sTotalData As String
  Dim sLine As String
 
  'sUrl = "http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_1234.html"
  hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)

  If hSession Then hInternet = InternetOpenUrl(hSession, sUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)


End Sub

***
Again, any help is greatly appreciated.
Thanks
Frank
0
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
Comment Utility
Frank

I've seen it but never used it.

Have you tried it?

I actually jut found this code which appears to deal with the Internet Cache by deleting an entry.

I've not tried it yet but perhaps it's worth a shot.

URLDownloadToFile: Fast, Simple and Transparent File Downloads Bypassing the IE Cache

I actually just noticed the code was updated at the end of last year which is  a good sign, I keep on finding code that's years old and though the idea is right I have to update it myself.
0
 

Author Comment

by:fsrebot
Comment Utility
I will try it

Thanks
Frank
0
 

Author Comment

by:fsrebot
Comment Utility
Hi imnorie,

 I tried it, and it works great.

I was ready to go with the option of configuring the local browser and setting it to check for newer versions everytime the webpage is visited, but this means the browser has to be managed.

The new code is more efficient.

Thank you!
Thank you!
Thank you!

Frank

p.s. Thank you!
0
 

Author Closing Comment

by:fsrebot
Comment Utility
This was a tough one for me. I really appreciate the help!!
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
Today's users almost expect this to happen in all search boxes. After all, if their favourite search engine juggles with tens of thousand keywords while they type, and suggests matching phrases on the fly, why shouldn't they expect the same from you…
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now