I am trying to use a partial name match to locate a template file (full name On-Call Audit Sheet VXX where VXX is the version) that gets updated from the current workbook with the macro I am writing.
The macro needs to locate the file with a partial name match; if found then open it and define the workbook as wb1, if not found then return an error. Current code below partially inspired by this post.
So far the macro can locate and open the file with partial name match using the FileSystemObject to grab the current folder path, but I can't work out how to then define wb1 with the partial name match.
Is there a way to get the full name of the file once the partial match is successful and thus define wb1 from that?
Sub anotherTest()
Dim fso As FileSystemObject
Dim fldBase As Folder
Dim wb1 As Workbook
Dim ws1 As Worksheet
Set fso = New FileSystemObject
'determining current folder location based on where the dashboard file is
Set fldBase = fso.GetFolder(ThisWorkbook.Path)
For Each Item In fldBase.Files
If InStr(Item.Name, "*Audit Sheet*") Then
Workbooks.Open (fldBase & "\" & Item.Name) '<-- Open workbook
Set wb1 = Workbooks(fldBase & "\" & Item.Name) '<-- set workbook to wb1, THIS BIT DOESNT WORK
Else
MsgBox "File not found" '<-- if not found exit sub after showing error
Exit Sub
End If
Next
'Rest of the macro
End Sub
Your code currently works on the basis that there is only ever one file that matches your *Audit Sheet* pattern. If there are 2 or more, then it will open them all but only point wb1 at the latest.
I assume this isn't what you want.
The following will open the first that it finds (so you might want to tighten up your pattern?) :
Sub Test()
Dim fldBase As String
Dim filefound As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
fldBase = "C:\yourbasefolder"
filefound = Dir(fldBase & "\" & "*Audit Sheet*.xlsm")
If filefound = "" Then
MsgBox "File not found" '<-- if not found exit sub after showing error
Exit Sub
Else
Set wb1 = Workbooks.Open(fldBase & "\" & filefound)
End If
'Rest of the macro
End Sub
Related
I have a workbook which opens up another workbook (filename is based on a cell value) and then runs a macro called Single_sector within that file.
It opens the file perfectly fine but doesn't run the macro. Any ideas?
Sub run_all()
Dim Location
On Error Resume Next
'Location of file to open
Location = Worksheets("Main").Range("folder_location").Value
'Open F&V File
Application.Workbooks.Open Location & Range("fv_file").Value
'Run Macro
Run ("Single_sector")
End Sub
Place the following code in the macro calling the other workbook:
Location = Worksheets("Main").Range("folder_location").Value
Set wb = Workbooks.Open(Location & Range("fv_file").Value)
Application.Run "'" & wb.Name & "'!" & strSubToRun, Parameters
Set wb = Nothing
Parameters is an array of arguments that you want to pass, so the sub in the other workbook should look something like
Public Sub TheSub(ParamArray X())
Dim i As Long
Sheet1.Cells(1, 1).Value = "Parameters passed:"
For i = 0 To UBound(X(0))
Sheet1.Cells(i + 2, 1).Value = CStr(X(i))
Next
End Sub
Probably not very elegant but:
Dim Location As String
Location = "\\location\to\file.xlsm"
Workbooks.Open(Location).RunAutoMacros (xlAutoOpen)
Where you have an Auto_Open Sub in your other excel file to handle the macros to run on your other spreadsheet
Please make sure your code in another workbook is at Workbook_open event so you dont need to use Run ("Single_sector"). The procedure single_selector would trigger as soon as another workbook is open.
Updated answer
Sub run_all()
Dim Location
On Error Resume Next
Dim wkb As Workbook
'Location of file to open
Location = Worksheets("Main").Range("folder_location").Value
'Open F&V File
Set wkb = Workbooks.Open(Location & Range("fv_file").Value)
wkb.Sheets(1).Single_sector ' kindly put this proc in another workbook sheet1
End Sub
I am trying to copy a module from one excel workbook to another using VBA.
My Code:
'Copy Macros
Dim comp As Object
Set comp = ThisWorkbook.VBProject.VBComponents("Module2")
Set Target = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm").VBProject.VBComponents.Add(1)
For some reason, this copies the module, but does not copy the VBA code inside, why?
Please can someone show me where i am going wrong?
Thanks
Sub CopyModule below, receives 3 parameters:
1.Source Workbook (as Workbook).
2.Module Name to Copy (as String).
3.Target Workbook (as Workbook).
CopyModule Code
Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)
' Description: copies a module from one workbook to another
' example: CopyModule Workbooks(ThisWorkbook), "Module2",
' Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
' Notes: If Module to be copied already exists, it is removed first,
' and afterwards copied
Dim strFolder As String
Dim strTempFile As String
Dim FName As String
If Trim(strModuleName) = vbNullString Then
Exit Sub
End If
If TargetWB Is Nothing Then
MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
Exit Sub
End If
strFolder = SourceWB.Path
If Len(strFolder) = 0 Then strFolder = CurDir
' create temp file and copy "Module2" into it
strFolder = strFolder & "\"
strTempFile = strFolder & "~tmpexport.bas"
On Error Resume Next
FName = Environ("Temp") & "\" & strModuleName & ".bas"
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
MsgBox "Error copying module " & strModuleName & " from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
Exit Sub
End If
End If
' remove "Module2" if already exits in destination workbook
With TargetWB.VBProject.VBComponents
.Remove .Item(strModuleName)
End With
' copy "Module2" from temp file to destination workbook
SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
TargetWB.VBProject.VBComponents.Import strTempFile
Kill strTempFile
On Error GoTo 0
End Sub
Main Sub Code (for running this code with the Post's data):
Option Explicit
Public Sub Main()
Dim WB1 As Workbook
Dim WB2 As Workbook
Set WB1 = ThisWorkbook
Set WB2 = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
Call CopyModule(WB1, "Module2", WB2)
End Sub
Actually, you don't need to save anything to a temporary file at all. You can use the .AddFromString method of the destination module to add the string value of the source. Try the following code:
Sub CopyModule()
Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
Set SourceVBProject = ThisWorkbook.VBProject
Dim NewWb As Workbook
Set NewWb = Workbooks.Add ' Or whatever workbook object you have for the destination
Set DestinationVBProject = NewWb.VBProject
'
Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
' Add a new module to the destination project
Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
'
With SourceModule
DestinationModule.AddFromString .Lines(1, .CountOfLines)
End With
End Sub
Should be self-explanatory! The .AddFomString method simply takes a string variable. So in order to get that, we use the .Lines property of the source module. The first argument (1) is the start line, and the second argument is the end line number. In this case, we want all the lines, so we use the .CountOfLines property.
Fantastic Code by Chris Melville, Thanks a ton, just a few small addition which i did & added few comments.
Just make sure, following things are done before running this macro.
VB Editor > Tools > References > (Check) Microsoft Visual Basic for Applications Extensibility 5.3
File -> Options -> Trust Center -> Trust Center Setttings -> Macro Settings -> Trust Access to the VBA Project object model.
Once you do above thing, copy & paste below code in Source File
Sub CopyMacrosToExistingWorkbook()
'Copy this VBA Code in SourceMacroModule, & run this macro in Destination workbook by pressing Alt+F8, the whole module gets copied to destination File.
Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
Set SourceVBProject = ThisWorkbook.VBProject
Dim NewWb As Workbook
Set NewWb = ActiveWorkbook ' Or whatever workbook object you have for the destination
Set DestinationVBProject = NewWb.VBProject
'
Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
' Add a new module to the destination project
Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
'
With SourceModule
DestinationModule.AddFromString .Lines(1, .CountOfLines)
End With
End Sub
Now run the "CopyMacrosToExistingWorkbook" macro in destination file, you will see the source file macro copied to destination file.
I had a lot of trouble getting the previous answers to work, so I thought I'd post my solution. This function is used to programmatically copy modules from a source workbook to a newly created workbook that was also created programmatically with a call to worksheet.copy. What doesn't happen when a worksheet is copied to a new workbook is the transfer of the macros that the worksheet depends upon. This procedure iterates through all modules in the source workbook and copies them into the new one. What's more is that it actually worked for me in Excel 2016.
Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)
Dim vbcompSource As VBComponent, vbcompTarget As VBComponent
Dim sText As String, nType As Long
For Each vbcompSource In wbSource.VBProject.VBComponents
nType = vbcompSource.Type
If nType < 100 Then '100=vbext_ct_Document -- the only module type we would not want to copy
Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
vbcompTarget.CodeModule.AddFromString (sText)
vbcompTarget.Name = vbcompSource.Name
End If
Next vbcompSource
End Sub
The function should hopefully be as simple as possible and fairly self-explanatory.
You can try
Open both workbooks
Open VBA Dev window
Dropdown Modules and drag and drop a copy from one module are to another
This is to make sure Module Names are not duplicated.
Also if you have modules that contain same named function / Subs then there will be a clash.
I do this and then run debug. Seems to work fine.
P.S. I copy many in to my PERSONAL.xlsb
I'm trying to search a closed excel file for a match then pull references relative to that match into a string which will then go into the open word doc, then repeat until all matches are found. I'm completely stuck on simply opening the excel file to access it to search to start with though.
It generates an excel process in task manager but I'm not able to reference it and I would actually expect it to open the application. I might be going about this the wrong way entirely.
Sub stringPrompt2()
'Find match
'build output
'put into word doc
'repeat
Dim sSearchString As String
Dim sSearchDirectory As String
Dim dlgFile As FileDialog
Dim vSelectedItem As Variant
Dim Loc As Excel.Range
Dim sPath As String
sSearchString = InputBox("String to search for", vbOKOnly, "Search String")
Set vSelectedItem = Application.FileDialog(filedialogtype:=msoFileDialogFilePicker)
With vSelectedItem
.AllowMultiSelect = False
.Show
End With
sPath = vSelectedItem.SelectedItems.Item(1)
Workbooks.Open sPath ' it isn't launching excel here.
End Sub
You just need to create a variable to hold the workbook reference and assign the result of the Workbooks.Open command to that variable so that you can work with it :
Dim myWorkbook As Workbook
Set myWorkbook = Workbooks.Open sPath
' Then do whatever you want with the Workbook object
MsgBox(myWorkbook.Name)
I am using a workbook that generates reports according to the country selected. Each country uses an specific path directory.
When it comes to import information form their root folder its OK.
My problem is when I generate a new workbook with the report. I try to save it in the specific location which changes with the country:
'Generate a new workbook refering to the first Worksheet
Set WkReport = Workbooks.Add(xlWBATWorksheet)
With WkReport
// Skip selecting the sheet, just reference it explicitly and copy it after//
// the blank sheet in the new wb.
ThisWorkbook.Worksheets("REPORT").Copy after:=.Worksheets(.Worksheets.Count)
End With
// Kill alerts, delete the blank sheet in the new wb and turn alerts back on//
Application.DisplayAlerts = False
With WkReport
.SaveAs Filename:="L:\Fold1\Fold2\Fold3\" & rngFolder & "\" & rngYear & "\" & rngMonth &"\"& rngName & "_Report_" & rngDate & ".xlsx"
End With
Application.DisplayAlerts = True'`enter code here`
L:\Fold1\Fold2\Fold3: fixed path
rngFolder is the Path for the Country
rngYear is the Path for a subfolder within Country
rngMonth is the Path for a subfolder within the Year
(rngSmthing are ranges referring to cells in the workbook)
All those are dynamics ranges that changes according to information introduced by the user.
Therefore when I create the workbook it must be saved in different location according to this information.
Name of the file contains another dynamic range "rngName" followed up by Report and "rngDate":
Filename = rngName_Report_rngDate.xlsx
What my code does is to save in L:\Fold1\Fold2\Fold3 with the filename Report.xlsx
Examples of Path directories if user selects...
Germany:
L:Folder1\Folder2\Folder3\Germany\2015\06-2015\GE_Report_31-06-15.xlsx
Hungary:
L:Folder1\Folder2\Folder3\Hungary\2015\06_2015\HU_Report_31-06-15.xlsx
!PROBLEM SOLVED! I simply forgot to set the rngSmthng Variables... (Clap Clap) Anyway, someone may find it useful in case that you want to set different save paths according to your ranges:
'cellRef is a named cell within the workbook where user selects data
rngName = ws.Range("cellRef").Value
In that way you have a dynamic path finder.
Glad you found the answer. As a side-note - this is how I would write the procedure.
Sub Test()
Dim wkReport As Workbook
Dim sFolder As String
Dim sPath As String
Dim rngFolder As Range
Dim rngName As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rngFolder = .Range("A1")
Set rngName = .Range("A2")
End With
sFolder = "L:\Fold1\Fold2\Fold3\" & rngFolder & "\" & Format(Date, "yyyy\\mm mmm\\")
CreateFolder sFolder
sPath = sFolder & rngName & "_Report_" & Format(Date, "dd-mm-yy") & ".xlsx"
Set wkReport = Workbooks.Add(xlWBATWorksheet)
With wkReport
ThisWorkbook.Worksheets("REPORT").Copy after:=.Worksheets(.Worksheets.Count)
.Worksheets(1).Delete
.SaveAs sPath, ThisWorkbook.FileFormat
End With
End Sub
' Purpose : Will Recursively Build A Directory Tree
Sub CreateFolder(Folder)
On Error Resume Next
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
If Folder <> "" Then
If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then
Call CreateFolder(objFSO.GetParentFolderName(Folder))
End If
objFSO.CreateFolder (Folder)
End If
End Sub
Note:
Format(Date, "yyyy\\mm mmm\\") will return 2015\12 Dec\.
Format(Date, "yyyy\mm mmm\") will return 2015m12 Dec.
Really sorry guys...
And many thanks for your help... no way you could have guessed it.
The problem was that those variables I have them set in a different macro, which I completely forgot... so of course it does not recognize the variables.. because I didnt create them in this Macro!!
Again my apologies should review my code twice before posting
I want to collect data from different files and insert it into a workbook doing something like this.
Do While THAT_DIFFERENT_FILE_SOMEWHERE_ON_MY_HDD.Cells(Rand, 1).Value <> "" And Rand < 65536
then 'I will search if the last row in my main worksheet is in this file...
End Loop
If the last row from my main worksheet is in the file, I'll quit the While Loop. If not, I'll copy everything. I'm having trouble finding the right algorithm for this.
My problem is that I don't know how to access different workbooks.
The best (and easiest) way to copy data from a workbook to another is to use the object model of Excel.
Option Explicit
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet2").Range("C3:D4").Value = wb.Worksheets("Sheet1").Range("A1:B2").Value
End Sub
You might like the function GetInfoFromClosedFile()
Edit: Since the above link does not seem to work anymore, I am adding alternate link 1 and alternate link 2 + code:
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "" Then wbPath = wbPath & ""
If Dir(wbPath & "" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
Are you looking for the syntax to open them:
Dim wkbk As Workbook
Set wkbk = Workbooks.Open("C:\MyDirectory\mysheet.xlsx")
Then, you can use wkbk.Sheets(1).Range("3:3") (or whatever you need)
There's very little reason not to open multiple workbooks in Excel. Key lines of code are:
Application.EnableEvents = False
Application.ScreenUpdating = False
...then you won't see anything whilst the code runs, and no code will run that is associated with the opening of the second workbook. Then there are...
Application.DisplayAlerts = False
Application.Calculation = xlManual
...so as to stop you getting pop-up messages associated with the content of the second file, and to avoid any slow re-calculations. Ensure you set back to True/xlAutomatic at end of your programming
If opening the second workbook is not going to cause performance issues, you may as well do it. In fact, having the second workbook open will make it very beneficial when attempting to debug your code if some of the secondary files do not conform to the expected format
Here is some expert guidance on using multiple Excel files that gives an overview of the different methods available for referencing data
An extension question would be how to cycle through multiple files contained in the same folder. You can use the Windows folder picker using:
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .Selected.Items.Count = 1 the InputFolder = .SelectedItems(1)
End With
FName = VBA.Dir(InputFolder)
Do While FName <> ""
'''Do function here
FName = VBA.Dir()
Loop
Hopefully some of the above will be of use
I had the same question but applying the provided solutions changed the file to write in. Once I selected the new excel file, I was also writing in that file and not in my original file. My solution for this issue is below:
Sub GetData()
Dim excelapp As Application
Dim source As Workbook
Dim srcSH1 As Worksheet
Dim sh As Worksheet
Dim path As String
Dim nmr As Long
Dim i As Long
nmr = 20
Set excelapp = New Application
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
.Show
path = .SelectedItems.Item(1)
End With
Set source = excelapp.Workbooks.Open(path)
Set srcSH1 = source.Worksheets("Sheet1")
Set sh = Sheets("Sheet1")
For i = 1 To nmr
sh.Cells(i, "A").Value = srcSH1.Cells(i, "A").Value
Next i
End Sub
With excelapp a new application will be called. The with block sets the path for the external file. Finally, I set the external Workbook with source and srcSH1 as a Worksheet within the external sheet.