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)
Related
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
Picture above is the master workbook. Can anyone help me to write the vba so it will find workbooks throughout the root folder (e.g. C:\Work\2017) that match with the account number and copy the B9 and E9 cells to the master cell. The 2nd picture is a system generated workbook with random name (e.g. export!-097a0sdk.xls), that's why I need a shortcut to make this task easier.
This is the result I expected by using the code
This is the excel generated by system
Thank you
If I understood correctly then the following will loop through a given directory and it will open and check each file for the required information, if found, it will add the values to your Master workbook.
Note: This code will not open a file if it has "Master" in its filename.
Sub LoopThroughFolder()
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim wb As Workbook
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim myFile As File
Dim AccNumber As String
Dim LastRow As Long, i As Long
Dim sPath As String
sPath = "C:\Work\2017"
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Application.DisplayAlerts = False
'do not display alerts
Set myFolder = FSO.GetFolder(sPath) 'set the root folder
For Each myFile In myFolder.Files 'for each file in the folder
If InStr(myFile.Name, "Master") = 0 Then
'if file to open does not have "Master" in it's name then
Set wb = Workbooks.Open(myFile.Path) 'open the file
AccNumber = wb.Sheets(1).Range("B2") 'check for account number on first Sheet
For i = 1 To LastRow 'loop through current Sheet to check if we have a match for the account number
If ws.Cells(i, 1) = AccNumber Then 'if match
ws.Cells(i, 2) = wb.Sheets(1).Range("B9") 'pass the values from the required range
ws.Cells(i, 3) = wb.Sheets(1).Range("E9")
End If
Next i
wb.Close False 'close and do not save changes
Set wb = Nothing
End If
Next
Application.DisplayAlerts = True
End Sub
Also you might have to set a reference to the relevant library to use FileSystemObject, to do that:
How do I use FileSystemObject in VBA?
Within Excel you need to set a reference to the VB script run-time library.
The relevant file is usually located at \Windows\System32\scrrun.dll
To reference this file, load the
Visual Basic Editor (ALT+F11)
Select Tools > References from the drop-down menu
A listbox of available references will be displayed
Tick the check-box next to 'Microsoft Scripting Runtime'
The full name and path of the scrrun.dll file will be displayed below the listbox
Click on the OK button.
So the issue I'm having is we have a schedule program made via excel, that is set to replace all user names and shift times with "####" and where it would normally display names inputs "Contact blah blah for new version." This occured on 1/1/15. For now they can backdate their computer to a date prior to 1/1/15 and once they type a value in to any cell the worksheet runs and all their data re-appears. We have locations across the country that saves the file every two weeks to Wildcardname.xls I'm looking for a way to program a command button that finds the other random name opened workbook, goes to hidden sheet "help" and changes the value of Cell A184 to "01/01/2016" or any date I plug in. Which would remove the "####" issue and replace it with the originally inputed values. The user could then save the file and carry on.
I was browsing through various help boards and found this..prompts a user to select the workbook. This would be the workbook that needs changed.
http://www.excelforum.com/excel-programming-vba-macros/695467-copy-values-from-a-worksheet-to-another-workbook-source-workbook-name-unknown.html
Sub CopyData()
Dim DstRng As Range
Dim DstWkb As Workbook
Dim DstWks As Worksheet
Dim FileFilter As String
Dim Filename As String
Dim SrcRng As Range
Dim SrcWkb As Workbook
Dim SrcWks As Worksheet
Dim SheetName As String
SheetName = "Output Table"
FileFilter = "Excel Workbooks (*.xls), *.xls"
Filename = Application.GetOpenFilename(FileFilter, , "Open Source Workbook")
If Filename = "False" Then
MsgBox "Open Source File Canceled."
Exit Sub
End If
Set SrcWkb = Workbooks.Open(Filename)
Set SrcWks = SrcWkb.Worksheets(SheetName)
Set SrcRng = SrcWks.Range("A2:H20")
FileFilter = "Excel Workbooks (*.xls), *.xls"
Filename = Application.GetOpenFilename(FileFilter, , "Open Destination Workbook")
If Filename = "False" Then
MsgBox "Open Destination File Canceled."
Exit Sub
End If
Set DstWkb = Workbooks.Open(Filename)
Set DstWks = DstWkb.Worksheets(SheetName)
Set DstRng = DstWks.Range("A2:H20")
SrcRng.Copy Destination:=DstRng
End Sub
Can this be modified to accomplish what I want to complete?
I can't post an image yet, so here's a link to a mock up. Before shot of the program on the left, and on the right is what I want it to look like.
http://i528.photobucket.com/albums/dd330/DLN1223/mockup.jpg
Hopefully this description makes since....
Thanks in advance for your help.
This is what I use:
Dim FileToOpen As Variant
Dim WKbook as workbook
FileToOpen = Application.GetOpenFilename("Excel files (*.xlsx),*.xlsx", , "Select Workbook to Open")
If FileToOpen = False Then Exit Sub 'quit on cancel
Set Wkbook = Workbooks.Open(FileToOpen, False, False)
With this, I can the set the value I want, and save changes
Wkbook.Sheets("help").Range("A184")=#1/1/2016#
Wkbook.Close SaveChanges:=True
depending on the filetype, you may need to change Excel files (*.xlsx),*.xlsx to Excel files (*.xls),*.xls
I would like to rename each workbook in a folder as the name of the first worksheet in the workbook. For example, if the Workbook is called "71107" and the worksheet in that workbook is called "foobar", I would like the workbook to be renamed "foobar".
My current progress is as follows:
Sub RunMe()
Dim objFSO As New FileSystemObject
Dim objWkbk As Workbook
Dim objFile As File
Dim folderpath As String
Application.ScreenUpdating = False
folderpath = "D:\test\"
For Each objFile In objFSO.GetFolder(folderpath).Files
oldpath = objFile.path
Set objWkbk = Workbooks.Open(oldpath)
newpath = path & "NEWNAME\" & ActiveSheet.Name & ".xls"
objWkbk.SaveAs Filename:=newpath
objWkbk.Close
Next objFile
End Sub
This code runs extremely slowly (in the order of 10 seconds per file). My files are not large, only around 40kb each. Is there a faster way to perform this operation? I also don't need to save a new copy of each file, I'm quite happy to just rename the file I just don't know of a way to do that.
There are two things, which takes so long one is Open and SaveAs.
The Open can be avoided with ADO as mentioned and more details are here
Then you can also not use SaveAs because it is not opened but you can just rename the file using something like:
Name GivenLocation & OldFileName As GivenLocation & NewFileName
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.