Got some issues with my code in VBA, downloading and inserting images to my Excel doc.
I have the following code in a loop:
Set theShape = ws.Shapes.AddPicture( _
Filename:=myurl, _
linktofile:=msoFalse, _
savewithdocument:=msoCTrue, _
left:=left, _
top:=top, _
Width:=-1, _
Height:=-1)
where “myurl” contains a link to the image, it works and the image is downloaded and inserted, but every time the code runs it opens a browser window and won’t continue until the window is manually closed.
I start the Sub with:
With Application
.Cursor = xlWait
.DisplayStatusBar = True
.WindowState = xlMaximized
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
.Interactive = False
.AskToUpdateLinks = False
.IgnoreRemoteRequests = False
End With
The browser window doesn’t display the image but the login to the actual site. The image is accessible without login and looking at the headers through powershell I can see the following:
PS C:\WINDOWS\system32> (wget https://www.deltaco.se/sites/cdn/PublishingImages/Products/hdmi-1022.jpg?width=80).Headers
Key Value
--- -----
SPRequestGuid 1042979e-00c5-c079-20f9-7d4f1f0a2f25
request-id 1042979e-00c5-c079-20f9-7d4f1f0a2f25
X-FRAME-OPTIONS SAMEORIGIN
MicrosoftSharePointTeamServices 15.0.0.4569
X-Content-Type-Options nosniff
X-MS-InvokeApp 1; RequireReadOnly
Access-Control-Allow-Origin *
Accept-Ranges bytes
Content-Length 1669
Cache-Control public, max-age=86400
Content-Type image/jpeg
Date Thu, 11 Oct 2018 07:08:06 GMT
ETag "{73EDFF3E-4289-4D00-A2E8-B3D5C0E3565A},4rend79_1"
Last-Modified Tue, 09 Oct 2018 06:45:17 GMT
Server Microsoft-IIS/8.5
X-AspNet-Version 4.0.30319
X-Powered-By ASP.NET
And:
PS C:\WINDOWS\system32> wget https://www.deltaco.se/sites/cdn/PublishingImages/Products/hdmi-1022.jpg?width=80
StatusCode : 200
StatusDescription : OK
Content : {255, 216, 255, 224...}
RawContent : HTTP/1.1 200 OK
SPRequestGuid: a942979e-a0b5-c079-20f9-788e9a1abf7c
request-id: a942979e-a0b5-c079-20f9-788e9a1abf7c
X-FRAME-OPTIONS: SAMEORIGIN
MicrosoftSharePointTeamServices: 15.0.0.4569
X-Con...
Headers : {[SPRequestGuid, a942979e-a0b5-c079-20f9-788e9a1abf7c], [request-id, a942979e-a0b5-c079-20f9-788e9a1abf7c], [X-FRAME-OPTIONS, SAMEORIGIN], [MicrosoftSharePointTeamServices, 15.0.0.4569]...}
RawContentLength : 1669
(Powershell got nothing to do with the issue, just used it to check the headers)
I can’t see any redirects or other reason for the code to open a browser window.
How can I prevent the browser window to open at all?
Welcome to Stackoverflow Anders
If the image is accessible without url then you can use the API URLDownloadToFile
See this example. I have commented the code. If you still have a problem understanding it, let me know.
Option Explicit
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 Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Sub Sample()
Dim myurl As String, tempFilePath As String
Dim Ret As Variant
Dim theShape As Shape
Dim ws As Worksheet
'~~> Set this to the relevant sheet
Set ws = Sheet1
'~~> Img URL
myurl = "https://www.deltaco.se/sites/cdn/PublishingImages/Products/hdmi-1022.jpg"
'~~> Get user temp path and the image name from the above url
'~~> For exmaple C:\Users\xxxxx\AppData\Local\Temp\hdmi-1022.jpg
tempFilePath = TempPath & GetFilenameFromURL(myurl)
'~~> Download the image and save it as tempFilePath
Ret = URLDownloadToFile(0, myurl, tempFilePath, 0, 0)
If Ret = 0 Then
'~~> File successfully downloaded
'~~> Add the shape
Set theShape = ws.Shapes.AddPicture( _
Filename:=tempFilePath, _
linktofile:=msoFalse, _
savewithdocument:=msoCTrue, _
Left:=10, _
Top:=10, _
Width:=-1, _
Height:=-1)
DoEvents
'~~> Delete the img file in the temp directory
Kill tempFilePath
Else
MsgBox "Unable to download the file"
End If
End Sub
'~~> Function to get user temp directory
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
'~~> Function to get Image name from URL
Function GetFilenameFromURL(ByVal strPath As String) As String
If Right$(strPath, 1) <> "/" And Len(strPath) > 0 Then
GetFilenameFromURL = GetFilenameFromURL(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
Tags: browser, excelexcel, vba