Adjust or change this macro to open a specific file

[Phillip2]

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

 

[smozgur]

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.

 

[Phillip2]

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

 

[smozgur]

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:

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

 

[Phillip2]

Thank you so much that was it!