Solved

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

Posted on 2012-03-29
22
361 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 13
  • 8
22 Comments
 
LVL 34

Expert Comment

by:Norie
ID: 37781748
Frank

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

Author Comment

by:fsrebot
ID: 37781909
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 34

Expert Comment

by:Norie
ID: 37782108
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
U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

 

Author Comment

by:fsrebot
ID: 37784273
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
ID: 37790890
If you right click on "DownloadFile" and then click on Definition, it should take you to the function.
0
 

Author Comment

by:fsrebot
ID: 37797980
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 34

Expert Comment

by:Norie
ID: 37798028
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
ID: 37798157
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 34

Expert Comment

by:Norie
ID: 37798409
Frank

How are you opening the image in Access?
0
 

Author Comment

by:fsrebot
ID: 37798451
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
ID: 37799069
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
 
LVL 34

Expert Comment

by:Norie
ID: 37799186
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
ID: 37801485
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 34

Expert Comment

by:Norie
ID: 37801536
Frank

Are you creating this temporaruy folder?
0
 

Author Comment

by:fsrebot
ID: 37801563
The folder w ascreated when the app is loaded.

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

Thanks

Frank
0
 
LVL 34

Expert Comment

by:Norie
ID: 37801656
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
ID: 37801741
No, its the same all the time

'c:\Serv2000REMOTE\sig.jpg'

Thanks

Frank
0
 

Author Comment

by:fsrebot
ID: 37804171
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 34

Accepted Solution

by:
Norie earned 500 total points
ID: 37804267
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
ID: 37804303
I will try it

Thanks
Frank
0
 

Author Comment

by:fsrebot
ID: 37808285
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
ID: 37808296
This was a tough one for me. I really appreciate the help!!
0

Featured Post

Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Phishing attempts can come in all forms, shapes and sizes. No matter how familiar you think you are with them, always remember to take extra precaution when opening an email with attachments or links.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

734 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