Adjust or change this macro to open a specific file

Phillip2

New Member
Joined
Aug 5, 2019
Messages
27
Office Version
365
Platform
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
 

smozgur

BatCoder
Joined
Feb 28, 2002
Messages
881
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

New Member
Joined
Aug 5, 2019
Messages
27
Office Version
365
Platform
Windows
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

BatCoder
Joined
Feb 28, 2002
Messages
881
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
 

Forum statistics

Threads
1,081,695
Messages
5,360,686
Members
400,592
Latest member
katekoz

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top