Forum

Rewriting VBA code ...
 
Notifications
Clear all

Rewriting VBA code when save as different file name

6 Posts
2 Users
0 Reactions
161 Views
(@stevenbehr1)
Posts: 92
Estimable Member
Topic starter
 

Hi,

 

I have VBA codes in my database indicating the workbook name such as Spare_Parts_Order_Matic_2.2.xlsm.

If I need to change/SaveAs the file to Site_Spare, is there any examples where from the SaveAs point, Change the VBA coding automatically from Spare Parts to Site Spare. The code below as an example on what I got on various procedures.

Sub ClearOrderLine()
'
' ClearOrderLine Macro
'
' Keyboard Shortcut: Ctrl+Shift+J
'
    Sheets("ProductToLocationStockQTY").Select
    Range( _
        "A2,E2,I2,M2,Q2,U2,Y2,AC2,AG2,AK2,AO2,AS2,AW2,BA2,BE2,BI2,BM2,BQ2,BU2,BY2,CC2,CG2" _
        ).Select
    Selection.ClearContents
    Sheet9.Range("A1").Select
    Application.Run "'Spare_Parts_Order_Matic_2.2.xlsm'!PtoLArow1"
    Application.Run "'Spare_Parts_Order_Matic_2.2.xlsm'!PtoLBrow1"
 

Reason being, I have to change 126 lines in VBA in different procedures with Site Spare but realized why the macro in the file wont work because I saved it as Site spare with Spare Parts Code.

 

Thanks

Steve

 
Posted : 01/07/2020 8:53 pm
(@rhysand)
Posts: 80
Trusted Member
 
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

 
Posted : 02/07/2020 12:33 pm
(@rhysand)
Posts: 80
Trusted Member
 

Hello,

Even without feedback on what you really want, I think you were wondering how to replace code in Vbproject

For that, you don't need to write any Macro, and having a Macro to run this procedure, it would require  the VBproject is unlocked

and VBProject has a tool to do that

I'm using Office 2013 Pro (English version on one laptop, and Portuguese on another)


Just open the VBA window, choosing Edit & Find on the menu bar, clicking the Find button on the Standard toolbar, or by pressing "Ctrl+F" or "Ctrl+H", to open a dialog box.

The Portuguese version is "Ctrl + L"

With this tool, you can search and replace everything you want at once on VBProject.


Regards,

Miguel

Capturar.JPG


 
Posted : 04/07/2020 5:29 am
(@stevenbehr1)
Posts: 92
Estimable Member
Topic starter
 

Yes sorry Migel, I'm coming back to work tomorrow sydney time as I am on holidays for 4 days. Your explanation is something that I am interested in reading and testing the VBA language. I will let you know in coming days...without my work computer I'm totally blind! But really appreciate your help Steve

 
Posted : 05/07/2020 2:57 am
(@stevenbehr1)
Posts: 92
Estimable Member
Topic starter
 

Hi Miguel,

You are right its not easy but I do have vaious errors simply because of the structure of my database and very long modules and codes. - It had taken 

However, with that in mind. There is a different database which is very small but handy, I used your Macro code and found that it was useful. In fact, that is exactly what I needed.

I think that because the amount of modules in my other database with various codes it searched throughout the DB that it came up with various errors to much to mentioned.

But I do thank you for this its made my other databases worthwhile redoing

 

Thanks

Steve

 
Posted : 01/08/2020 6:24 pm
(@rhysand)
Posts: 80
Trusted Member
 
You're welcome
 
Posted : 03/08/2020 12:29 pm
Share: