VBA Dir and HTTP Directories Equivalent

[syl]

Hello, I'm still pretty new at this, and my vba code is a bit rushed although it works.
My question is, can I change the "If lngvar" parts to loop? Also will it work faster than "if then" statement:clap:? Thank you.


Sub GetShapeFromWeb()


On Error Resume Next


Dim var As String
Dim lngvar As Long

LR = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To LR

var = Cells(x, 12).Value
lngvar = Len(var)

If lngvar = 7 Then
var = "000000" & var
ElseIf lngvar = 8 Then
var = "00000" & var
ElseIf lngvar = 9 Then
var = "0000" & var
ElseIf lngvar = 10 Then
var = "000" & var
ElseIf lngvar = 11 Then
var = "00" & var
ElseIf lngvar = 12 Then
var = "0" & var
Else
var = var
End If

Call InsertShape("http//wwwwebsitecom/" & var & ".jpg", Sheet1.Range("B2").End(xlUp).Offset(x - 1, 0))

Next x

Call FitAllPics.FitAllPics


errormsg:
Exit Sub

End Sub

[Trebor76]

Hi syl,

Welcome to the forum!!

There's no need to loop that part of your code at all:


Sub GetShapeFromWeb()

On Error GoTo errormsg

Dim var As String
Dim lngvar As Long
Dim LR As Long
Dim x As Long

Application.ScreenUpdating = False

LR = Cells(Rows.Count, 1).End(xlUp).Row '<- This sets the LR variable from the last row in Col. A yet the code below loops through Col. L???

For x = 2 To LR

If Len(Cells(x, 12).Value) >= 7 And Len(Cells(x, 12).Value) <= 12 Then
var = Application.WorksheetFunction.Rept("0", 13 - Len(Cells(x, 12).Value)) & Cells(x, 12).Value
Else
var = Cells(x, 12).Value
End If

Call InsertShape("http//wwwwebsitecom/" & var & ".jpg", Sheet1.Range("B2").End(xlUp).Offset(x - 1, 0))

Next x

Call FitAllPics.FitAllPics

Application.ScreenUpdating = True

Exit Sub

errormsg:

Application.ScreenUpdating = True

End Sub

I also made some other changes and queried why you set the LR variable from Col. A yet your code is scrolling down Col. L??

Regards,

Robert

[snb]

I'd use:


Sub M_snb()
sn=cells(1).currentregion

For j = 2 To Ubound(sn)
InsertShape "http//wwwwebsitecom/" & right("00000" & sn(j,12),12) & ".jpg", Sheet1.Range("B2").End(xlUp).Offset(1)
Next

FitAllPics.FitAllPics
End Sub

[syl]

Thank you Robert and snb!


Hi syl,

Welcome to the forum!!

There's no need to loop that part of your code at all:


Sub GetShapeFromWeb()

On Error GoTo errormsg

Dim var As String
Dim lngvar As Long
Dim LR As Long
Dim x As Long

Application.ScreenUpdating = False

LR = Cells(Rows.Count, 1).End(xlUp).Row '<- This sets the LR variable from the last row in Col. A yet the code below loops through Col. L???

For x = 2 To LR

If Len(Cells(x, 12).Value) >= 7 And Len(Cells(x, 12).Value) <= 12 Then
var = Application.WorksheetFunction.Rept("0", 13 - Len(Cells(x, 12).Value)) & Cells(x, 12).Value
Else
var = Cells(x, 12).Value
End If

Call InsertShape("http//wwwwebsitecom/" & var & ".jpg", Sheet1.Range("B2").End(xlUp).Offset(x - 1, 0))

Next x

Call FitAllPics.FitAllPics

Application.ScreenUpdating = True

Exit Sub

errormsg:

Application.ScreenUpdating = True

End Sub

I also made some other changes and queried why you set the LR variable from Col. A yet your code is scrolling down Col. L??

Regards,

Robert

I'm trying to automatically put a product image from my company's database to the excel sheet just by inputting its barcode. My solution is to make a button with macros on it, so it can be copy pasted to other sheets.
The barcodes are always on Col. L, and the photos are on Col. B (They are pretty strict on this).
There could be 10 or 1000 products in the sheet, each one is different. Also often there aren't any image for the inputted barcode on the database resulting in error, and I need the macro to continue to the next barcode until everythings finished.

I'm just using google and copypasting any relevant codes with a lot of trial and error, so excuse me if my code caused headache lol.

EDIT: Also the reason for leading 0 is the barcodes on the sheet can be anything from 8 to 13 numbers, while in the database it's always 13 numbers. They just add 0 on the front of the numbers until it's 13.

[SamT]

For x = 2 To LR
var = Format(Cells(x, 12), "000000000000") '13 zeros
Call InsertShape("http//wwwwebsitecom/" & var & ".jpg", Sheet1.Range("B" & x))
Next

Note that .Range("B2").End(xlUp) is the same as .Range("B1") However, Range("B3").End(xlUp) may not be the same, depending on the condition of B2

[syl]

For x = 2 To LR
var = Format(Cells(x, 12), "000000000000") '13 zeros
Call InsertShape("http//wwwwebsitecom/" & var & ".jpg", Sheet1.Range("B" & x))
Next

Note that .Range("B2").End(xlUp) is the same as .Range("B1") However, Range("B3").End(xlUp) may not be the same, depending on the condition of B2

:facepalm: I know I'm missing something obvious haha. That Format is easy to read and works great! And thank you for the Range explanation, I'm just starting to understand my own code. Though why B3 and B2 could be different?

Also I've read that On Error Resume Next should never be used. Is there any alternative to continue the loop when InsertShape failed?

EDIT: I've just realized there are .gif and maybe other image file other than .jpg. So I'd like to check if the .gif image and maybe others are there when the first one (.jpg) throw an error. Thank you!

[syl]

:facepalm: I know I'm missing something obvious haha. That Format is easy to read and works great! And thank you for the Range explanation, I'm just starting to understand my own code. Though why B3 and B2 could be different?

Also I've read that On Error Resume Next should never be used. Is there any alternative to continue the loop when InsertShape failed?

EDIT: I've just realized there are .gif and maybe other image file other than .jpg. So I'd like to check if the .gif image and maybe others are there when the first one (.jpg) throw an error. Thank you!

Just updating my own question with my own answer:


var = Format(Cells(x, 12), "0000000000000") '13 zeros

url_jpg = "http/" & var & ".jpg"
url_gif = "http/" & var & ".gif"
url_png = "http/" & var & ".png"

Call InsertShape(url_jpg, ActiveSheet.Range("B" & x))
Call InsertShape(url_gif, ActiveSheet.Range("B" & x))
Call InsertShape(url_png, ActiveSheet.Range("B" & x))



So essentially I'm calling 3 functions for each loop, with at least 2 of them always resulting in error. Would really like to hear other solutions though, because I'm using On Error Resume Next to brute force through the errors...

[SamT]

because I'm using On Error Resume Next to brute force through the errors...
That's what "On Error Resume Next" was invented for... Sometimes the best you have is brute force. The alternative is to check for the existence of each file before inserting it. If you take that route, those checks should be in the InsertShape sub, or a FileCheck Function

Call InsertShape(var, ActiveSheet.Range("B" & x))
'Or
InsertShape(FileCheck(var), ActiveSheet.Range("B" & x))


Though why B3 and B2 could be different?
Experiment:
Place values in B2 and B3, leave B1 empty.
Select B3, press Ctrl+Up arrow. (Same as VBA "End(xlUp)")
The rule holds for any cell in any Row other than Row 2.

[syl]

I see, thank you. I've tried to write a function to check if the url exist or not before InsertShape sub, but it took much longer time than expected compared to brute force. Now I'm trying to make the code only calls the url_gif if the 1st one returns an error, and url_png if the 1st and second one also return an error. So If Call InsertShape(url_jpg, ActiveSheet.Range("B" & x)) = error then goto Call InsertShape(url_gif, ActiveSheet.Range("B" & x)) else Next x. Not much success so far.

[SamT]

Unfortunately, I don't know how to access all files in a Website Folder.

On a Local Hard Drive it's very easy

ActualImageName = Dir("C:\WINDOWS\" & var & ".*")

I am Renaming this thread just for this issue

[syl]

Just updating my own question with my own answer:


var = Format(Cells(x, 12), "0000000000000") '13 zeros

url_jpg = "http/" & var & ".jpg"
url_gif = "http/" & var & ".gif"
url_png = "http/" & var & ".png"

Call InsertShape(url_jpg, ActiveSheet.Range("B" & x))
Call InsertShape(url_gif, ActiveSheet.Range("B" & x))
Call InsertShape(url_png, ActiveSheet.Range("B" & x))



So essentially I'm calling 3 functions for each loop, with at least 2 of them always resulting in error. Would really like to hear other solutions though, because I'm using On Error Resume Next to brute force through the errors...

Just wanted to share my recent discovery, because I'm pretty excited.



Call InsertShape(url_jpg, ActiveSheet.Range("B" & x))
If Err.Number = 1004 Then
Call InsertShape(url_gif, ActiveSheet.Range("B" & x))
Call InsertShape(url_png, ActiveSheet.Range("B" & x))
End If


So now it will only brute force if the first code throws error number 1004, and the loop still continues.
As the result it's up to 30% faster! :D