Adjust or change this macro to open a specific file

Phillip2

Board Regular
Joined
Aug 5, 2019
Messages
79
Office Version
  1. 365
Platform
  1. Windows
I have a user that generates several different reports from a non-excel program for multiple departments. These reports are converted and saved into a folder as .xlsb files. I have a macro that is saved inside another folder which formats these reports. I’m building a separate worksheet that will be a control sheet for lack of a better term. From this sheet I trigger a macro which uses the expression “Application.GetOpenFilename” to open a folder containing the excel file and then opens another folder containing the VBA text file.


Currently user navigates to the folder and chooses each of the files that are being used. Then the macro completes its mission by placing the VBA text file inside excel file. The macro works beautifully.
However, what I would like to do is place direct links for the excel and text files into the macro and have this process completed automatically. (The files will always be saves using the same name.)

How can I adjust the existing macro to accomplish this task?

Thank you so much for your help.




------------------------------------------------------------------------------------------------------------------
Sub injectMacro()
Dim vbcomp As Object
Dim wbFn As Variant, txtFn As Variant, wb As Variant
Dim ff As Long
Dim line As String, vbCode As String, fn As String



' -------------------------------------------Excel File----------------------------- I'm wanting to change this to so that it will open a specific file


wbFn = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)

If TypeName(wbFn) = "Boolean" Then Exit Sub 'User cancelled



--------------------------------------VBA TXT File------------------------------- I'm wanting to change this to so that it will open a specific file


txtFn = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If TypeName(txtFn) = "Boolean" Then Exit Sub 'User cancelled




With CreateObject("Scripting.FileSystemObject").OpenTextFile(txtFn, 1)
vbCode = .readall
.Close
End With

'Debug.Print vbCode
Application.ScreenUpdating = False
On Error GoTo clean_exit
For Each wb In wbFn
With Workbooks.Open(wb)
Set vbcomp = .VBProject.VBComponents("ThisWorkbook")
vbcomp.CodeModule.AddFromString vbCode
Set vbcomp = Nothing
Select Case UCase(Right(wb, 4))
Case "XLSB", "XLSM", ".XLS"
.Close True
Case Else
'Save as macro enabled workbook
ff = 0
fn = Left(wb, InStrRev(wb, ".")) & "xlsm"
While LenB(Dir(fn))
ff = ff + 1
fn = Left(wb, InStrRev(wb, ".") - 1) & "(" & ff & ").xlsm"
Wend
.SaveAs fn, 52
.Close False
End Select
End With
Next wb

clean_exit:
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Application.GetOpenFilename() returns the path of the selected file.

So, if you assign txtFn string variable as the full file path, then it will work as you need - OpenTextFile will use the string variable as the file path to open the specific file.

txtFn = "C:\Your\File\Path\Filename.ext"

However, wbFn looks to be expecting an array as I can see from your code (multiselect GetOpenFilename() and for each loop). Then still same thing, only you need to provide an array of file paths for that variable.
 
Upvote 0
Smozgur,

Thank you so much for your help. I changed wbFn and TxtFn to the appropriate addresses. The macro runs without error but now it isn’t working.

There really shouldn’t be an array. This is only inserting one VBA text file into a single workbook. So that might be my problem. How would I would I go about changing that?


Sub injectMacro()
Dim vbcomp As Object
Dim wbFn As Variant, txtFn As Variant, WB As Variant
Dim ff As Long
Dim line As String, vbCode As String, fn As String

wbFn = "C:\Users\chs103233\Documents\reports\DeerFoot\Sample Report C.xlsb"
If TypeName(wbFn) = "Boolean" Then Exit Sub 'User cancelled

txtFn = "C:\Users\chs103233\Documents\reports\DeerFoot\VBA\Sample vba.txt"
If TypeName(txtFn) = "Boolean" Then Exit Sub 'User cancelled

With CreateObject("Scripting.FileSystemObject").OpenTextFile(txtFn, 1)
vbCode = .readall
.Close
End With

'Debug.Print vbCode
Application.ScreenUpdating = False
On Error GoTo clean_exit

For Each WB In wbFn
With Workbooks.Open(WB)
Set vbcomp = .VBProject.VBComponents("ThisWorkbook")
vbcomp.CodeModule.AddFromString vbCode
Set vbcomp = Nothing
Select Case UCase(Right(WB, 4))
Case "XLSB", "XLSM", ".XLS"
.Close True
Case Else
'Save as macro enabled workbook
ff = 0
fn = Left(WB, InStrRev(WB, ".")) & "xlsm"
While LenB(Dir(fn))
ff = ff + 1
fn = Left(WB, InStrRev(WB, ".") - 1) & "(" & ff & ").xlsm"
Wend
.SaveAs fn, 52
.Close False
End Select
End With
Next WB

clean_exit:
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
 
Upvote 0
It "looks" like it is working, but it actually fails, because wbFn is supposed to be a string array, not a string.
You can understand why by looking at the code:
  1. The original code is using MultiSelect option as True for GetOpenFilename() method. So it returns an array as I said in my initial comment.
  2. For Each WB In wbFn : this is the line that your code needs wbFn as an array.
  3. On Error GoTo clean_exit : this is the previous line that avoids the error, so you never see it is failing at #1.
You should either change your code to work with "single" workbook instead iterating in the supposedly provided workbook paths, or easier way could be keeping the same code but providing wbFn as expected as a single element array as shown below:

VBA Code:
wbFn = Array("C:\Users\chs103233\Documents\reports\DeerFoot\Sample Report C.xlsb")

If the original code works beautifully, then it should continue working after this change.
The advantage of using an array would be changing multiple workbooks at once.

Note: You don't need the following lines since you are now assigning the parameter values hard coded, not by using GetOpenFilename().

If TypeName(wbFn) = "Boolean" Then Exit Sub 'User cancelled
If TypeName(txtFn) = "Boolean" Then Exit Sub 'User cancelled
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top