an error occurred while importing this File

[amine]

Hi everyone ;
I'm a .NET software developer facing an issue with Excel Macro, can anyone help me please :

Issue :

- > Error message : an error occurred while importing this File.
- > Scenario : I have an xlsm file that is connected to a web API through multiple queries, the query get's also images name from database so that after some columns print the images passing by the like + image name (https://........./images/.....jpg) there is a macro and VBA behind it I'll print it down below.

the file used to work fine until on day some microsoft and office 365 update came, the file now throws the "an error occurred while importing this File" which i think happens when the excel file tries to load images.

Any one can help to bypass that issue, i'm not good in macros/Excel so I can't think I can settle the issue alone.

Down below the VB / Macro code for the images (don't know really what it does) :

>>> You opened this thread as Ask an Excel Question ... instead of VBA Macros <<<
>>> Moved to correct Forum <<<

>>> use code - tags <<<

Sub SuppressionImage(CasePourPhoto As Range)
Dim Sh As Shape
With CasePourPhoto.Worksheet
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, CasePourPhoto.MergeArea) Is Nothing Then
         Sh.Delete
       End If
    Next Sh
End With
End Sub
Sub SelectionImage(CasePourPhoto As Range)
Dim Sh As Shape
CasePourPhoto.Select
With CasePourPhoto.Worksheet
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, CasePourPhoto.MergeArea) Is Nothing Then
         Sh.Select
       End If
    Next Sh
End With
End Sub
Function URLPictureInsert(URL As String, CasePourPhoto As Range) As String

Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
Dim FirstWorksheet As Worksheet
On Error Resume Next
    FirstWorksheet = Application.ActiveSheet
    'Application.ScreenUpdating = False
    Set Rng = CasePourPhoto
    For Each cell In Rng
        CasePourPhoto.Worksheet.Activate
        SuppressionImage CasePourPhoto
        If Not FirstWorksheet Is Nothing Then
            If CasePourPhoto.Worksheet.CodeName <> FirstWorksheet.CodeName Then Exit Function
        End If
        On Error Resume Next
        CasePourPhoto.Worksheet.Activate
        CasePourPhoto.Worksheet.Pictures.Insert(URL).Select
        SelectionImage CasePourPhoto
        Set Pshp = Selection.ShapeRange.Item(1)
        'If Pshp = Nothing Then Exit For
        xCol = cell.Column
        Set xRg = CasePourPhoto.Worksheet.Cells(cell.Row, xCol)
        With Pshp
            .LockAspectRatio = msoFalse
            .Width = xRg.MergeArea.Width - xRg.MergeArea.Width / 10
            .Height = xRg.MergeArea.Height - xRg.MergeArea.Height / 10
            .Top = xRg.Top + (xRg.MergeArea.Height - .Height) / 2
            .Left = xRg.Left + (xRg.MergeArea.Width - .Width) / 2
           
            'Pshp.Select
            'Set octl = Application.CommandBars.FindControl(ID:=6382)
            'Application.SendKeys "%(oe){TAB}{UP}"
            'Application.CommandBars.ExecuteMso "PicturesCompress"
            'octl.Execute
        End With
lab:
        Set Pshp = Nothing
        'Range("A2").Select
    Next
    'Application.ScreenUpdating = True
    URLPictureInsert = "Image Updated at " & Now
End Function

 

[amine]

Updates :

It's the 'CasePourPhoto.Worksheet.Pictures.Insert(URL).Select ' that throws the error

----> I tested the URL on the browser and it works fine he prints the image

 

[Marc L]

Hi,​

​

try first to incorporate manually 'this File" in a worksheet and, if you succeed,​

just activate the Macro Recorder and redo the same in order to compare​

the generated code with your VBA procedure.​

​

Or maybe you can try to cancel the 365 update …​

​

 

[amine]

Hi Marc,

Thank a lot for you response. I actually created a simple workbook with the vb and it still throws the same error when trying to print image.

>>> as You've noted <<<
>>> use code - tags <<<

Sub InsertImageFromURL()

    Dim ImageURL As String

    Dim TargetCell As Range

    Dim Image As Picture

 

    ' Define the URL for the image

    ImageURL = "https://link:port/Images/WPCV/87648615.jpg"

 

    ' Define the target cell where the image will be inserted (A1 in this example)

    Set TargetCell = ThisWorkbook.Sheets("Feuil1").Range("A1")

 

    ' Delete any existing shapes in the target cell

    SuppressionImage TargetCell

 

    ' Call the URLPictureInsert function to insert the image

    Set Image = URLPictureInsert(ImageURL, TargetCell)

 

    ' If the image was inserted, position it in the target cell

    If Not Image Is Nothing Then

        With Image

            .Top = TargetCell.Top

            .Left = TargetCell.Left

        End With

    End If

End Sub

 

Sub SuppressionImage(CasePourPhoto As Range)

    Dim Sh As Shape

    With CasePourPhoto.Worksheet

        For Each Sh In .Shapes

            If Not Application.Intersect(Sh.TopLeftCell, CasePourPhoto.MergeArea) Is Nothing Then

                Sh.Delete

            End If

        Next Sh

    End With

End Sub

 

Function URLPictureInsert(URL As String, CasePourPhoto As Range) As Picture

    On Error Resume Next

    ' Insert the image from the URL

    Set URLPictureInsert = CasePourPhoto.Worksheet.Pictures.Insert(URL)

 

    ' Check if the image was successfully inserted

    If URLPictureInsert Is Nothing Then

        MsgBox "An error occurred while inserting the image from the URL.", vbExclamation

    End If

End Function

It sure it doesn't have authorisation but i don't know what to grant i granted everything from macro to external content, safe location...

 

[amine]

Hi Marc,

Thank a lot for you response. I actually created a simple workbook with the vb and it still throws the same error when trying to print image.

Sub InsertImageFromURL()

Dim ImageURL As String

Dim TargetCell As Range

Dim Image As Picture



' Define the URL for the image

ImageURL = "https://linkort/Images/WPCV/87648615.jpg"



' Define the target cell where the image will be inserted (A1 in this example)

Set TargetCell = ThisWorkbook.Sheets("Feuil1").Range("A1")



' Delete any existing shapes in the target cell

SuppressionImage TargetCell



' Call the URLPictureInsert function to insert the image

Set Image = URLPictureInsert(ImageURL, TargetCell)



' If the image was inserted, position it in the target cell

If Not Image Is Nothing Then

With Image

.Top = TargetCell.Top

.Left = TargetCell.Left

End With

End If

End Sub



Sub SuppressionImage(CasePourPhoto As Range)

Dim Sh As Shape

With CasePourPhoto.Worksheet

For Each Sh In .Shapes

If Not Application.Intersect(Sh.TopLeftCell, CasePourPhoto.MergeArea) Is Nothing Then

Sh.Delete

End If

Next Sh

End With

End Sub



Function URLPictureInsert(URL As String, CasePourPhoto As Range) As Picture

On Error Resume Next

' Insert the image from the URL

Set URLPictureInsert = CasePourPhoto.Worksheet.Pictures.Insert(URL)



' Check if the image was successfully inserted

If URLPictureInsert Is Nothing Then

MsgBox "An error occurred while inserting the image from the URL.", vbExclamation

End If

End Function

It sure it doesn't have authorisation but i don't know what to grant i granted everything from macro to external content, safe location...

i wanted to say link: port * on the emoj printed

 

[Marc L]

I can't test as it seems your URL is private …​

​

 

[rlv01]

It's the 'CasePourPhoto.Worksheet.Pictures.Insert(URL).Select ' that throws the error

Q1: That statement is contained within a loop ( For Each cell In rng ). Does the above statement always throw an error or just sometimes?

Q2: If you create a very simple test sub and feed it a known-good URL, do you still get the error?

'Tested and works for me for my known-good picture URL
Sub PicInsertTest()
    Dim URL As String, CasePourPhoto As Range

    URL = "https://chandoo.org/wp/wp-content/uploads/2018/06/new-logo-white.png"    '<---- replace with your known-good url
   
    Set CasePourPhoto = ActiveSheet.Range("A1")       '<---- replace with YOUR range

    CasePourPhoto.Worksheet.Pictures.Insert(URL).Select
End Sub