Rewriting VBA code when save as different file name|VBA & Macros|Excel Forum|My Online Training Hub

Hello,

it's not easy, because I didn't fully understand the question... but I will leave here an example

first: in my example I have one folder with only two excel workbooks

In one Workbook with the name: "OpenMyMacro.xlsm", 
I have one module with one macro with the name "HelloWorld" with a msgbox "Hello from: " & Application.ThisWorkbook.Name

In the second Workbook put these codes in Userform module:

Private Sub CommandButton1_Click()

Dim getFileName As String
Dim xCount As Integer
Dim cell As Range
Dim cellRange As Range
Dim f As String
Dim WorkbookName As String
Dim MacroName As String
Dim FileToClose As String
Dim FileToOpen As String
Dim x As String

xCount = CountFilesInFolder(Application.ThisWorkbook.Path)

Debug.Print xCount

If xCount <> 2 Then Exit Sub ' in my example if files count is not 2 (function)

Call Get_All_Files_In_Folders

ActiveSheet.Select

Set cellRange = Range("B1:B2")

For Each cell In cellRange
     If cell.Value <> Application.ThisWorkbook.Name Then
          f = cell.Value
     End If
Next cell

Debug.Print f

'WorkbookName = "OpenMyMacro.xlsm"
WorkbookName = f ' workbook name
MacroName = "HelloWorld" ' macro name

FileToClose = Application.ThisWorkbook.Path & "\" & WorkbookName
FileToOpen = Application.ThisWorkbook.Path & "\" & WorkbookName

'determine if file exists
On Error Resume Next
x = CreateObject("scripting.filesystemobject").FileExists(FileToClose)
On Error GoTo 0

Debug.Print x

If x = False Then GoTo FileNoExists:

'open another workbook and run macro
Application.EnableEvents = False
Application.ScreenUpdating = False

Application.Run "'" & FileToOpen & "'!" & MacroName

'close another workbook
Workbooks(Dir(FileToClose)).Close SaveChanges:=False

Application.EnableEvents = True
Application.ScreenUpdating = True

Exit Sub

FileNoExists:
     MsgBox "file does not exist or could not be found", vbCritical, "Error"
End Sub

Public Function CountFilesInFolder(fileDir As String) As Integer ' count files in folder

Dim xFile As Variant

Dim x As Integer

If Right(fileDir, 1) <> "\" Then fileDir = fileDir & "\"
xFile = Dir(fileDir)

While (xFile <> "")
     x = x + 1
     xFile = Dir
Wend

CountFilesInFolder = x

End Function

Public Sub Get_All_Files_In_Folders() ' get all files path & names in folder

Dim MyPath As String, MyFolderName As String, MyFileName As String
Dim i As Integer
Dim AllFolders As Object, AllFiles As Object

MyPath = Application.ThisWorkbook.Path & "\"

'List all folders
Set AllFolders = CreateObject("Scripting.Dictionary")
Set AllFiles = CreateObject("Scripting.Dictionary")
AllFolders.Add (MyPath), ""
i = 0

Do While i < AllFolders.Count
     Key = AllFolders.Keys
     MyFolderName = Dir(Key(i), vbDirectory)
     Do While MyFolderName <> ""
          If MyFolderName <> "." And MyFolderName <> ".." Then
               If (GetAttr(Key(i) & MyFolderName) And vbDirectory) = vbDirectory Then
                    AllFolders.Add (Key(i) & MyFolderName & "\"), ""
               End If
          End If
          MyFolderName = Dir
     Loop
     i = i + 1
Loop

'List all files
For Each Key In AllFolders.Keys
     MyFileName = Dir(Key & "*.*")
     Do While MyFileName <> ""
          AllFiles.Add (MyFileName), Key
          MyFileName = Dir
     Loop
Next

ActiveSheet.Select
ActiveSheet.Cells.Delete

ActiveSheet.[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.Items) ' file path
ActiveSheet.[B1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.Keys) ' file name

If Not AllFolders Is Nothing Then Set AllFolders = Nothing
If Not AllFiles Is Nothing Then Set AllFiles = Nothing

End Sub

I can change the name of the Workbook "OpenMyMacro.xlsm " whenever I want, and I will always be able to open the macro

Regards,

Miguel

You're welcome