Had to borrow some code from : http://jiwhite.blogspot.be/2009/03/p...-from-url.html
First things first !!! make a copy of your excel file and test this code in the copy not in your original file !!!
It will temporarly dowload the pic to a location , so rename the C:\Users\******\Downloads\ to whatever your preferd location is , the pic will be deleted after import anyway.
So copy the below in a module and update location and then run it.
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
Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Function DownloadFile(sSourceURL As String, _
sLocalFile As String) As Boolean
DownloadFile = URLDownloadToFile(0&, _
sSourceURL, _
sLocalFile, _
BINDF_GETNEWESTVERSION, _
0&) = ERROR_SUCCESS
End Function
Sub picimport()
For X = 1 To 100
Dim Xrow As String
Dim Xvalue As String
Xrow = X
Xvalue = Sheets("Sheet1").Range("B" & Xrow).Value
If Xvalue = "" Then
Exit Sub
Else
Dim sURL As String
Dim sLocalFile As String
Dim sDestination As String
Dim sText As String
sText = Xvalue
sURL = sText
sLocalFile = "C:\Users\******\Downloads\test.png"
DownloadFile sURL, sLocalFile
Set pic = ActiveSheet.Pictures.Insert("C:\Users\******\Downloads\test.png")
Sheets("Sheet1").Range("V" & Xrow).Select
If Not pic Is Nothing Then
Set Rng = ActiveCell
With pic
.Height = Rng.Height
.Width = Rng.Width
.Left = Rng.Left
.Top = Rng.Top
End With
End If
End If
Kill "C:\Users\******\Downloads\test.png"
Next X
End Sub
LinkBack URL
About LinkBacks
elmaco12 
Register To Reply
- Which is "the first time" error message?
Bookmarks