VBA Dir and HTTP Directories Equivalent

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.

Code:

---

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

---

Hi syl,

Welcome to the forum!!

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

Code:

---

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'd use:

Code:

---

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

---

Thank you Robert and snb!

Quote:

---

Originally Posted by Trebor76

Hi syl,

Welcome to the forum!!

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

Code:

---

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.

Code:

---

    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

Quote:

---

Originally Posted by SamT

Code:

---

    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!

Quote:

---

Originally Posted by 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:

Code:

---

    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...

Quote:

---

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

Code:

---

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

---

Quote:

---

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.

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.

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

On a Local Hard Drive it's very easy

Code:

---

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

---

I am Renaming this thread just for this issue

Quote:

---

Originally Posted by syl

Just updating my own question with my own answer:

Code:

---

    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.

Code:

---

   
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