VBA代码打开一个不需要的浏览器窗口

Posted 2021-04-03

我的代码在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与此问题无关，只是用它来检查标题）

我看不到代码打开浏览器窗口的任何重定向或其他原因。

如何阻止浏览器窗口打开？

答案

欢迎来到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