0 votes
in VBA by Beginner (12 points)
Hi I've an issue with my VBA script, which is at every time I need to edit my script when I use new reports because names of pictures are not constante they aad always name of commune to the pic for example:
FOR commune LOR3104 : LOR3104_Near_S1_DL.png
                                               LOR3104_Near_S1_UL.png
AND
FOR commune LCH2230 : LCH2230_Near_S1_DL.png
                                               LCH2230_Near_S1_UL.png

'load the ranges & associated files in two arrays of the same length:
      arrFiles = Array("Near_S1_DL.png", "Near_S1_UL.png")

arrRanges = Array(Sheets("Sector_Near POINT").Range("B8"), Sheets("Sector_Near POINT").Range("N8"))
 In this case I always edit the logs before using the VBA, and i've a lot of pictures so it takes time so please if you can help me just do it.
thank you.
by Expert (798 points)
Can you post the whole code ..?

I can't get what you mean in your description..
by Beginner (12 points)

Here are tghe code,

Public Sub FilesInSubFolders()
Dim i As Long
Dim diaFolder As FileDialog 
Dim rng As Range
Dim shp As Shape
Dim strRootDir As String, strMsg As String
Dim arrFiles As Variant, arrRanges As Variant

    'load the ranges & associated files in two arrays of the same length:
      arrFiles = Array("Near_S1_DL.png", "Near_S1_UL.png", "Near_S1_AttachDettach_Ping.png", "Near_S1_MOC_1.png", "Near_S1_MOC_2.png", "Near_S1_MTC_1.png", "Near_S1_MTC_2.png", _
                  "Near_S2_DL.png", "Near_S2_UL.png", "Near_S2_AttachDettach_Ping.png", "Near_S2_MOC_1.png", "Near_S2_MOC_2.png", "Near_S2_MTC_1.png", "Near_S2_MTC_2.png", _
                  "Near_S3_DL.png", "Near_S3_UL.png", "Near_S3_AttachDettach_Ping.png", "Near_S3_MOC_1.png", "Near_S3_MOC_2.png", "Near_S3_MTC_1.png", "Near_S3_MTC_2.png")



    
arrRanges = Array(Sheets("Sector_Near POINT").Range("B8"), Sheets("Sector_Near POINT").Range("N8"), Sheets("PING Near_Far  point ").Range("B8"), Sheets("CSFB_MOC & Reselection S1 S2 S3").Range("B7"), Sheets("CSFB_MOC & Reselection S1 S2 S3").Range("N7"), Sheets("CSFB_MTC & Reselection S1 S2 S3").Range("B7"), Sheets("CSFB_MTC & Reselection S1 S2 S3").Range("N7"), _
                  Sheets("Sector_Near POINT").Range("B43"), Sheets("Sector_Near POINT").Range("N43"), Sheets("PING Near_Far  point ").Range("B33"), Sheets("CSFB_MOC & Reselection S1 S2 S3").Range("B33"), Sheets("CSFB_MOC & Reselection S1 S2 S3").Range("N33"), Sheets("CSFB_MTC & Reselection S1 S2 S3").Range("B33"), Sheets("CSFB_MTC & Reselection S1 S2 S3").Range("N33"), _
                  Sheets("Sector_Near POINT").Range("B77"), Sheets("Sector_Near POINT").Range("N77"), Sheets("PING Near_Far  point ").Range("B58"), Sheets("CSFB_MOC & Reselection S1 S2 S3").Range("B59"), Sheets("CSFB_MOC & Reselection S1 S2 S3").Range("N59"), Sheets("CSFB_MTC & Reselection S1 S2 S3").Range("B59"), Sheets("CSFB_MTC & Reselection S1 S2 S3").Range("N59"))
      
      
      
    If UBound(arrFiles) <> UBound(arrRanges) Then
        MsgBox ("Dev Check: Unequal number of files & ranges specified.")
        Exit Sub
    End If
    
   
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show
    strRootDir = diaFolder.SelectedItems(1)
   

    For i = LBound(arrFiles) To UBound(arrFiles)
        gblStrPathAndFile = ""
        gblStrFileToFind = arrFiles(i)
        'starting in the root directory, search for each file - set the full path name if found:
        Call GetSubDirectories(strRootDir)
        If gblStrPathAndFile <> "" Then
            Set rng = arrRanges(i)
            With rng.MergeArea
                Set shp = Worksheets(rng.Parent.Name).Shapes.AddPicture(Filename:=gblStrPathAndFile, linkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
                shp.LockAspectRatio = msoFalse
            End With
            Set rng = Nothing
            Set shp = Nothing
        End If
    Next i

End Sub
Sub GetSubDirectories(strFolder As String)
Dim objFileSystem As Object, objFolder As Object, objSubFolder As Object
    
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFileSystem.GetFolder(strFolder)
    
    Call GetFiles(objFolder.Path)
    If gblStrPathAndFile <> "" Then
ExitWhenFound:
        On Error GoTo 0
        GoTo NormalExit
    End If
    
    On Error Resume Next    'avoid access permission errors.
    For Each objSubFolder In objFolder.subfolders
        If Err.Number = 0 Then
            GetSubDirectories (objFolder.Path & "\" & objSubFolder.Name)   'recursive call.
        Else
            Err.Clear
        End If
        If gblStrPathAndFile <> "" Then GoTo ExitWhenFound    'safeguard.
    Next objSubFolder

NormalExit:

End Sub

Sub GetFiles(strPath As String)
Dim objFile As Object, objFileSystem As Object, objFolder As Object
    
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFileSystem.GetFolder(strPath)
    
    On Error Resume Next    'avoid access permission errors.
    For Each objFile In objFolder.Files
        If Err.Number = 0 Then
            If objFile.Name = gblStrFileToFind Then
                gblStrPathAndFile = strPath & "\" & gblStrFileToFind
                Exit For
            End If
        Else
            Err.Clear
        End If
    Next objFile
    DoEvents
    
    
End Sub

thank you.

by Expert (798 points)
Why don't you store the pictures names in column instead of hard-coding them in the code .. ?

and is the name changinf fixed based on logic or it has no fixed logic ..? what is the logic exactly?
by Beginner (12 points)
Picture names are not fixed only one party is fix

the one i've been writing it in the code

im asking if i can add some thing to the path like whatever is before this path the VBA code will take it, for example:

instead of writing "LOR3104_Near_S1_DL.png"

I write " _ & "Near_S1_DL.png"

_ refer to LR3104 because it is the variable part in the name .

I hope you can got it.
by Expert (798 points)

I think inside the loop, you have to concatenate the dynamic part to the fixed part like that

gblStrFileToFind = "LOR3104_" & arrFiles(i)

 

by Beginner (12 points)

I konw it is hard to explain what I'm looking for, but I will try one more time if you don,t mind,

for the dynamic part in name can I USE SOMETHING LIKE THIS

" & Value & "Near_S1_DL.png",
 
by Expert (798 points)
Yes you can store the dynamic part in the name into variable and use it when you concatenate ..

Where will you store the variable (value) ..?
by Beginner (12 points)
IN THIS CASE NO IDEA
by Expert (798 points)
Can you use pictures (snapshots) to clarify the idea ..? I feel lost in fact

1 Answer

0 votes
by Skilled (330 points)

Hi Bouti!

Change just two lines in the GetFiles subroutine:

Sub GetFiles(strPath As String)
Dim objFile As Object, objFileSystem As Object, objFolder As Object

    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFileSystem.GetFolder(strPath)
    
    On Error Resume Next    'avoid access permission errors.
    For Each objFile In objFolder.Files
        If Err.Number = 0 Then
            If InStr(objFile.Name, gblStrFileToFind) > 0 Then ' CHANGED LINE
                gblStrPathAndFile = strPath & "\" & objFile.Name ' CHANGED LINE
                Exit For
            End If
        Else
            Err.Clear
        End If
    Next objFile
    DoEvents
    
    
End Sub

The first change, If InStr(objFile.Name, gblStrFileToFind) > 0 Then, allows you to test the current file name to see if it has the gblStrFileToFind anywhere in its name.

The second change, gblStrPathAndFile = strPath & "\" & objFile.Name, returns the full file name, which is the same thing you were looking to do with

" & Value & "Near_S1_DL.png",

Cheers,

Mitch
 

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...