Consulting

Results 1 to 11 of 11

Thread: VBA Dir and HTTP Directories Equivalent

  1. #1
    VBAX Regular
    Joined
    Mar 2018
    Posts
    6
    Location

    Question 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? 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

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

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

  4. #4
    VBAX Regular
    Joined
    Mar 2018
    Posts
    6
    Location
    Thank you Robert and snb!

    Quote Originally Posted by Trebor76 View Post
    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.
    Last edited by syl; 03-05-2018 at 05:13 AM. Reason: adding info

  5. #5
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
        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
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  6. #6
    VBAX Regular
    Joined
    Mar 2018
    Posts
    6
    Location
    Quote Originally Posted by SamT View Post
        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!
    Last edited by syl; 03-05-2018 at 05:59 PM. Reason: additional question

  7. #7
    VBAX Regular
    Joined
    Mar 2018
    Posts
    6
    Location
    Quote Originally Posted by syl View Post
    :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...
    Last edited by syl; 03-05-2018 at 08:28 PM. Reason: updating answer

  8. #8
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  9. #9
    VBAX Regular
    Joined
    Mar 2018
    Posts
    6
    Location
    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.
    Last edited by syl; 03-08-2018 at 03:24 AM. Reason: added detail

  10. #10
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  11. #11
    VBAX Regular
    Joined
    Mar 2018
    Posts
    6
    Location
    Quote Originally Posted by syl View Post
    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!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •