Form to Load /Save picture from Web URL

[tucker61]

I have a table in SQL which is full of hyperlinks to pictures.
What i want to do is from within a access form, look up the picture on hyperlink address, then save the picture to a local drive,

The URL is transferred to the MyPic String with no issues, but i am struggling to save this as a Jpg file.

I do not get any errors, it just does not save.

Do i have to do this a different way ?

Sub GetPicture(CatNo As String)
On Error GoTo Handler
Dim PicPath As String
Dim sLocalFile As String
Dim MyPic As String

            Call Open_Connection1(DB_Name1)
            strsql = "SELECT [URL] FROM [dbo].[Image_URLs] WHERE [CATALOGUE_NUMBER] = '" & CatNo & "'"
            Set rs = New ADODB.Recordset
            rs.Open strsql, cnAWS, adOpenStatic 'runs the defined query
            On Error Resume Next
            MyPic = rs("URL")
            Set rs = Nothing
            Call Close_Connection
            
    sLocalFile = Environ("Temp") & "\Pic.jpg"
    SaveFile MyPic, PicPath
    imgWeb.Picture = PicPath
    DoEvents
Exit Sub

 

[theDBguy]

Can you post the code for the SaveFile routine?

 

[moke123]

just tried this and it seems to work

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


Sub GetPick()
    Dim sin As String
    Dim sout As String

    Dim ret As Long

    sin = "  Your url here  "  
    sout = CurrentProject.Path & "\image.jpg"    'path to saved image location 

    ret = URLDownloadToFile(0, sin, sout, 0, 0)
    If (ret = 0) Then MsgBox "Succedded" Else MsgBox "failed"
End Sub

 

[tucker61]

Sub SaveFile(Source As String, Target As String)
Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFile Source, Target
    Set fs = Nothing
End Sub

 

[tucker61]

just tried this and it seems to work

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


Sub GetPick()
    Dim sin As String
    Dim sout As String

    Dim ret As Long

    sin = "  Your url here  " 
    sout = CurrentProject.Path & "\image.jpg"    'path to saved image location

    ret = URLDownloadToFile(0, sin, sout, 0, 0)
    If (ret = 0) Then MsgBox "Succedded" Else MsgBox "failed"
End Sub

Thanks, but i keep getting a fail. Ret value = -2146697208

 

[theDBguy]

Sub SaveFile(Source As String, Target As String)
Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFile Source, Target
    Set fs = Nothing
End Sub

I could be wrong, but I don't think FSO can copy a file from a URL to a local disk. I think the function @moke123 posted would be more like you want to use instead. If it's not working for you, you might also try using a HTTPRequest class.

 

[moke123]

modified to use arguments

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


 Sub GetPick(sin As String, sout As String)

    Dim ret As Long

    ret = URLDownloadToFile(0, sin, sout, 0, 0)
    If (ret = 0) Then MsgBox "Succedded" Else MsgBox "failed"
End Sub

tested with

Private Sub Command5_Click()
GetPick "https://img.webmd.com/dtmcms/live/webmd/consumer_assets/site_images/articles/health_tools/surprises_about_dogs_and_cats_slideshow/photolibrary_rm_photo_of_sneezing_woman_and_dog.jpg", CurrentProject.Path & "\image.jpg"

End Sub

I tested it with a few different urls and it worked for me each time.

 

[tucker61]

modified to use arguments

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


Sub GetPick(sin As String, sout As String)

    Dim ret As Long

    ret = URLDownloadToFile(0, sin, sout, 0, 0)
    If (ret = 0) Then MsgBox "Succedded" Else MsgBox "failed"
End Sub

tested with

Private Sub Command5_Click()
GetPick "https://img.webmd.com/dtmcms/live/webmd/consumer_assets/site_images/articles/health_tools/surprises_about_dogs_and_cats_slideshow/photolibrary_rm_photo_of_sneezing_woman_and_dog.jpg", CurrentProject.Path & "\image.jpg"

End Sub

I tested it with a few different urls and it worked for me each time.

 

[tucker61]

Thanks, now getting Access Crashing.
Using Access 64 bit in AWS environment.
Might try again tomorrow.

 

[moke123]

sorry, i'm access 2010 32bit.
probably a bitness issue.
good luck.

 

[theDBguy]

Thanks, now getting Access Crashing.
Using Access 64 bit in AWS environment.
Might try again tomorrow.

Just for fun, try adding PtrSafe. For example.

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA"

 

[tucker61]

Just for fun, try adding PtrSafe. For example.

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA"

Already done. Had to do that when testing.

 

[theDBguy]

Already done. Had to do that when testing.

In that case, have you tried using a HTTPRequest class?

 

[tucker61]

In that case, have you tried using a HTTPRequest class?

Not yet, might try that one tomorrow