• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Error while importing this file. worked for 10 years, suddenly stopped since 2 days...

chrisjaguar

New Member
Hello,

i have a macro that has worked as it is now since 10 years without any issue.

Since yesterday me and 2 other colleagues get this message when executing the code:
78405

This error is shown every time when there is no file with this name in the folder that is searched.
But in the last ten years with the same code what happened was that this line just didn't get a picture, no error was shown and the code continued untill the end of the loop.

since yesterday the error above is shown, it doesn't seem to be a VBA error.
and if it was shouldn't it be captured by the "on error resume next"?

I don't understand at all what happens and how it could be solved...

Anybody any ideas?

This is the code:


Code:
Sub FotoToevoegen()
    Application.ScreenUpdating = False

    Range("a1").EntireRow.Insert
    Range("B1").EntireColumn.Insert
    Range("B1").ColumnWidth = 19
    ActiveSheet.Rows("3:10000").RowHeight = 70
    
    Const Afb_map = "\\SRV006pomax.pomax.com\data\PomaxFotos\FotosResult\100x100\"
    myarray = WorksheetFunction.Transpose(Range("A3", Range("A" & Rows.Count).End(xlUp)).Value)
    ActiveSheet.Protect False, False, False, False, False
    If Not IsArray(myarray) Then Exit Sub
    On Error Resume Next
    lRow = 3
    For lLoop = LBound(myarray) To UBound(myarray)
        On Error Resume Next
        Set sShape = ActiveSheet.Shapes.AddPicture(Afb_map & myarray(lLoop) & ".jpg", msoFalse, msoCTrue, _
                Cells(1, 2).Left + 9, Cells(lRow, 2).Top + 8, 80, 60)
        On Error Resume Next
        lRow = lRow + 1
    Next lLoop
    
    
    Dim xPic As Picture
    On Error Resume Next
    
    For Each xPic In ActiveSheet.Pictures
        xPic.Placement = xlMoveAndSize
    Next
    
    Application.ScreenUpdating = True
End Sub


thanx a lot !

Kind regards,
Chris
 
chrisjaguar
Why there are three times On Error Resume Next?
If an error occure then error still stays ... there is none err.clear.
Have You checked - when/which line err.number is over 0?
 
Hello Vletm,

i added multiple errors to try and skip the error message about the import, but that clearly did not work.

if i removed them all i first get this error:
78406

if i click ok, then i get this:
78407
runtime error 1004 : application defined or object defined error.

and that then leads to this line:

Code:
        Set sShape = ActiveSheet.Shapes.AddPicture(Afb_map & myarray(lLoop) & ".jpg", msoFalse, msoCTrue, _
                Cells(1, 2).Left + 9, Cells(lRow, 2).Top + 8, 80, 60)
 
chrisjaguar
... hmm?
My the 1st - why ... ? Didn't mean that You should take all away.
One is okay ... and ... I would use just after Sub FotoToevoegen() -line.
#2 missing err.clear ... then any error stays alive.
#3 Could You run Your code line-by-line ( = step-by-step) ?
... and same time track all variables --- that are those correct?
This way - You could get an idea - which line of code makes unwanted error?

I tested Your code with empty sheet ... with tracking those variables
This should work other way! ... with empty sheet myarray ... hmm?
Screenshot 2022-04-08 at 19.28.26.png

... and if continues then before On Error Resume Next finally noticed something Err.Number 1004
Do You have something data in that sheet from cell A3?
Screenshot 2022-04-08 at 19.28.51.png
 
Last edited:
Vletm,

thanx for the pointers, i added all the variables to the watch list, added 1 on error resume next and err.clear.

There is nothing in cell A3, and that's when i first get the error message in excel about the import.
And only after that i click that message away and i then continue to step to the next line in the code then i can see the value 1004 for the err.Number in the watch list.

But the strange thing to me is that it allways worked in the past even if cell A3 or others were empty...
So i can't understand what is changed so this stops whenever a matching file for the value in column A is not found.

grtz,
Chris
 
chrisjaguar
Where did You add Err.Clear?
Did it give error as in my snapshot (#2)?
If there are none filenames ( = A3 and below is empty ) then the code won't know any files.
... as well as If Not IsArray(myarray) Then Exit Sub should work => Exit.

Have You tested to paste Afb_map's value \\SRV006pomax.pomax.com\data\PomaxFotos\FotosResult\100x100\ to Your browser?
Can You get something? ... You could see that paths folder - that's all.
How did this work in the past?
 
Vletm,

as you suggested i added on error resume next right after the line with the sub name.
err.clear idd just before Next lLoop.

And with every line where no file can be found (empty of wrong name) the error value is filled with 1004.
The lines where the file can be found error value is empty and picture is added.

If i paste the maps value in the browser then i get this:
78412


In the past (untill wednesday) it worked so that every empty line or line where no file could be found seemed to be skipped.
At least no error messages (from VBA or otherwise) were shown and code was continued until total array was done.
It was done daily maybe 50 to 100 times by 10 different people with arrays going from 10 references up to maybe 4000 references.
And almost allways there were missing files and it never caused a problem.

So i would guess that there must be something outside of the code that gives this changed behaviour (for multiple people at the same time).
and not easy to figure out what it is.
I need to get it solved by monday and quite stuck now.

So before it worked without a check to see if the file existed or not.
Maybe i need to check if the file exists first?
But no ideay on how to do that...
and also i'm afraid that it might slow it down for big lists....
 
chrisjaguar
I've seen something same before
#1 path should be absolute correct ( sometimes even [non]capital gotta be correct )
#2 there should be path separator between path and filename
#3 has users right to see those files?

Did You test to run Your code step-by-step?

I tested Your code
I could get It works someway with my given path.
I would add Err.Clear just after For Loop = ....
as well as skip empty myarray-values.
Without filenames from A3 ... You cannot get any pictures to show.

Here two code to test:
Code:
Sub test()
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .InitialFileName = "\\srv006pomax.pomax.com\data\PomaxFotos\FotosResult\100x100\"
        If .Show = -1 Then FilePath = .SelectedItems(1)
    End With
End Sub

Sub FileExistsDemo()
'VBA Check if File Exists
Dim strFile As String
    Afb_map = "\\srv006pomax.pomax.com\data\PomaxFotos\FotosResult\100x100\"
    strFile = Afb_map & "0007.jpg"
'   above should be as below with pathseparator
'   strFile = Afb_map & "\0007.jpg"
    If FileExists(strFile) Then
        MsgBox "File: Found"
    Else
        MsgBox "File: No"
    End If
End Sub
 
chrisjaguar
Could You explain ...
Your original error message has
Screenshot 2022-04-10 at 13.52.58.png
but Your used code has
Const Afb_map = "\\SRV006pomax.pomax.com\data\PomaxFotos\FotosResult\100x100\"

Something don't match.
 
vletm,

if i'm trying the check to see if the file exists i get the error that "fileexists" is not a defined sub or function?

The difference in used code an error message is because we use this code for several folders.
Depending on the use case the pictures need to come out of a different folder.
I did tests on all of them and probably mixed the error message with the wrong folder example.

But the path's seem to be ok, that's doesn't seem to be the issue.

Chris
 
Vletm,

i searched for the fileexists function and i found that i needed to add this extra sub:

Code:
Function FileExists(FilePath As String) As Boolean
Dim TestStr As String
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0
    If TestStr = "" Then
        FileExists = False
    Else
        FileExists = True
    End If
End Function

Now it works again.
Thanx you very much for all your help to solve this problem!!
Still wondering what caused the problem in the first place, why it suddenly stopped working as before.

i found some more people complaining online about the issue since last wednesday, but no solutions or explanations found...

have a nice day and kind regards,

Chris
 
chrisjaguar
Without answers to questions, it's a challenge to get needed information about You case.
Your original code cannot work based Your give information.
 
Hi Chris

Glad to see you worked this out, I am trying to use your code but not sure where I need to put it and what I need to change for the refernce in my code to import images?
Thanks
Digby
 
@Digby45 you can just use it in the same module (at the top before macro name) or a different page. & just use the fileexist as conditional if else to skip or exit the sub depending on your goal. worked for me. hope it does for you as well.
 
@chrisjaguar

how do you incorporate FileExists into a Sub

if fileexists(a variable) then insert picture else skip over?
Code:
Sub URLPictureInsert()
Dim filenam As String
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next

Application.ScreenUpdating = False

Set Rng = ActiveSheet.Range("B2:B3")
For Each cell In Rng
filenam = cell

Set Pshp = ActiveSheet.Shapes.AddPicture( _
Filename:=filenam, linktofile:=msoFalse, _
savewithdocument:=msoCTrue, _
Left:=cell.Left, Top:=cell.Top, Width:=-1, Height:=-1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
If .Width > xRg.Width Then .Width = xRg.Width * 2 / 3
If .Height > xRg.Height Then .Height = xRg.Height * 2 / 3
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("B2:B3").Select
Next
Application.ScreenUpdating = True
End Sub
 
Last edited:
You can simply use:

Code:
if dir(filenam) <> vbnullstring then
Set Pshp = ActiveSheet.Shapes.AddPicture( _
Filename:=filenam, linktofile:=msoFalse, _
savewithdocument:=msoCTrue, _
Left:=cell.Left, Top:=cell.Top, Width:=-1, Height:=-1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
If .Width > xRg.Width Then .Width = xRg.Width * 2 / 3
If .Height > xRg.Height Then .Height = xRg.Height * 2 / 3
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
end if
 
Back
Top