Код VBA открывает нежелательное окно браузера

Question

Возникли некоторые проблемы с моим кодом в VBA, загрузкой и вставкой изображений в документ Excel.

У меня есть следующий код в цикле:

Set theShape = ws.Shapes.AddPicture( _
    Filename:=myurl, _
    linktofile:=msoFalse, _
    savewithdocument:=msoCTrue, _
    left:=left, _
    top:=top, _
    Width:=-1, _
    Height:=-1)

, где "myurl" содержитссылка на изображение, оно работает, изображение загружается и вставляется, но каждый раз, когда запускается код, оно открывает окно браузера и не будет продолжать работу, пока окно не будет закрыто вручную.

Я запускаю Sub с:

With Application
.Cursor = xlWait
.DisplayStatusBar = True
.WindowState = xlMaximized
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
.Interactive = False
.AskToUpdateLinks = False
.IgnoreRemoteRequests = False
End With

В окне браузера отображается не изображение, а логин для фактического сайта.Изображение доступно без входа в систему и, глядя на заголовки через powershell. Я вижу следующее:

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

И:

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 не имеет ничего общего спроблема, просто использовал его для проверки заголовков)

Я не вижу никаких перенаправлений или других причин для кода, чтобы открыть окно браузера.

Как я могу предотвратить браузерокно вообще открыть?

Answer 1

Добро пожаловать в Stackoverflow Anders

Если изображение доступно без URL, тогда вы можете использовать API URLDownloadToFile

См. Этот пример.Я прокомментировал код.Если у вас все еще есть проблемы с пониманием, дайте мне знать.

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