Function Browse Folder Select but I have to Reload twice in subs What am I missing here

[PeeBee]

Hi All,
I am still a bit green in how all this hangs together.
I want to bet able to use the Value from Function ChooseFolder() once Folder is selected
to only load once and carry Folder Value through all my subs.I think my call sub structure may not be 100% correct
a fresh set of experienced eyes would be appreciated

the code below works in blank wookbook for testing if needed

thanks
regards Peter

Public Function ChooseFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String


    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With


NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function
Private Sub CommandButton1_Click()


    Dim FolderPath As String
    Dim rng As Range, File As Range
    Dim m As Integer
    Dim LR As Long
    Dim ws As Worksheet
    ' Dim FolderName As String
    'search worksheet change name as required
    Set ws = Worksheets("Sheet1") '
    
    'specify search folder FROM FUNCTION above 
    FolderPath = ChooseFolder()
    
       
    'check folder exists
    If Dir(FolderPath, vbDirectory) <> vbNullString Then
    
    'last record in column A
    LR = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'set the search ranges
    Set rng = Union(ws.Range("A2:A" & LR), ws.Range("C2:C" & LR))
    
    For Each File In rng
    
    'check if file Name in range (without file ext) exists in folder and add if Column H has extra text after main column C word
     m = Len(Dir(FolderPath & File.Value & Cells(1, 8) & ".*"))


    'change cell font colorindex based on result of m
   ws.Cells(File.Row, File.Column).Font.ColorIndex = IIf(m = 0, 3, xlAutomatic)
   
  '  ws.Cells(File.Row, File.Column).Font.ColorIndex = IIf(m <> 0, 10, xlAutomatic)
    
    Next File




    Else
    'tell user folder not found
    MsgBox FolderPath & Chr(10) & "Folder Path Not Found", 16, "Not Found"




    End If


Call ReName2
End Sub


Sub ReName2()
Dim FolderPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim File As Object
Dim LastRow As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
FolderPath = ChooseFolder() ' second call to function




Set objFolder = objFSO.GetFolder(FolderPath)  'set your directory of photos
LastRow = [a65536].End(xlUp).Row
For Each File In objFolder.Files
    For i = 1 To LastRow
     
   ' if there is no matching file name from column "C" then mark Cell = background Red?
       'If file.Name <> Cells(i, 3) & ".jpg" Then Cells(i, 3).Font.Color = vbRed?
         ' If file.Name = Cells(i, 3) & ".jpg" Then Cells(i, 3).Font.Color = vbBlack?




        If File.Name = Cells(i, 3) & Cells(1, 8) & ".jpg" Then File.Name = Cells(i, 1) & ".jpg"    '& Cells(i, 1).Font.Color = vbRed ???
        If File.Name = Cells(i, 3) & Cells(1, 8) & ".JPG" Then File.Name = Cells(i, 1) & ".JPG"
        If File.Name = Cells(i, 3) & Cells(1, 8) & ".bmp" Then File.Name = Cells(i, 1) & ".bmp"
        If File.Name = Cells(i, 3) & Cells(1, 8) & ".png" Then File.Name = Cells(i, 1) & ".png"
        If File.Name = Cells(i, 3) & Cells(1, 8) & ".eps" Then File.Name = Cells(i, 1) & ".eps"
        If File.Name = Cells(i, 3) & Cells(1, 8) & ".psd" Then File.Name = Cells(i, 1) & ".psd"
        
        
        
    Next i
Next File




End Sub

 

[mole999]

Have a look for declaring a Global variable at the top of the subs, then assign you value to that then reference from then on

 

[GTO]

Hi there,

You may wish to use a Static within the function to limit scope. Something like:

Option Explicit

Public Function ChooseFolder(Optional NewPick As Boolean = False) As String
Dim fldr      As FileDialog
Static sItem  As String

  If NewPick Or sItem = vbNullString Then
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fldr
      .Title = "Select a Folder"
      .AllowMultiSelect = False
      '.InitialFileName = strPath
      If .Show <> -1 Then GoTo NextCode
      sItem = .SelectedItems(1)
    End With
  End If
  
NextCode:
  ChooseFolder = sItem
  Set fldr = Nothing
End Function

Sub example()
  MsgBox ChooseFolder
  MsgBox ChooseFolder
  MsgBox ChooseFolder(True)
End Sub

Hope that helps,

Mark