VBA Open file with wildcard knowing only extension - vba

I am trying to get Excel to open any file in the a given folder
(ThisWorkbook.Path\Peach\Apple) that has .xlsm extension (there is always only 1 file). Is it possible to open it with wildcard character? I do not know the name of the file, just the extension.
If not, is there a way to do it?

Just ask the file system for the first matching file:
Dim path As String: path = ThisWorkbook.path & "\Peach\Apple\"
FindFirstFile = Dir$(path & "*.xlsm")
If (FindFirstFile <> "") Then
Workbooks.Open path & FindFirstFile
Else
'// not found
End If
(This will not search sub-directories)

You mentioned that it would be nice addition to open last modified file or file with shortest name, so let's start - there's a code example how you can grab all three files (first finded, last modified, with shortest name). You can modify this as you wish (add some parameters, add error handling, return only specified, etc).
Sub Test()
'declarations
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim path As String
Dim first_finded As Object
Dim recently_modified As Object
Dim shortest_name As Object
Dim recently As Date
Dim shortest As Long
Dim firstFinded As Boolean
'setting default recently date(24 hours from now) and path
recently = DateAdd("h", -24, Now)
path = ThisWorkbook.path & "\Peach\Apple\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
'iteration over folder
For Each file In folder.Files
If file.Name Like "*.xlsm" Then
'grab first finded .xlsm
If Not firstFinded Then
firstFinded = Not firstFinded
Set first_finded = file
End If
'grab lastmodified .xlsm
If file.DateLastModified > recently Then
recently = file.DateLastModified
Set recently_modified = file
End If
'grab short named .xlsm
If shortest = 0 Or shortest > Len(file.Name) Then
shortest = Len(file.Name)
Set shortest_name = file
End If
End If
Next
'debug-print names
Debug.Print first_finded.Name
Debug.Print recently_modified.Name
Debug.Print shortest_name.Name
'so now you can uncomment this and open what you want
'Call Workbooks.Open(path & recently_modified.Name)
End Sub

Try the code below, it will open your "*.xlsm" file, in the path you've requested.
Sub OpenXLSMWildcardfile()
Dim Path As String
Path = ThisWorkbook.Path & "\Peach\Apple\"
Workbooks.Open (Path & "*.xlsm")
End Sub

PFB for the code required for opening the macro file with extension(.xlsm).
Sub OpeningFile()
'Declaring variables
Dim FileName, FolderPath As String
'Initializing folder path
FolderPath = ThisWorkbook.Path & "\Peach\Apple\"
'Finding the file name using wildcard
FileName = Dir(FolderPath & "*.xlsm")
'Looping through the workbook which are saved as macro enabled workbooks
While FileName <> ""
Workbooks.Open FolderPath & FileName
FileName = Dir()
Wend
End Sub

Related

Name of the file inside the excel file cell using VBA

I need a VBA where it updates the "name of the excel file" inside that particular "excel file". There are 12 files in the folder. The path for this folder is D:\Amit. Name of those 12 files are "Cash Report as on 11-05-2017 0000Hrs" starting from Midnight (that's why 0000Hrs) and it increases by 2 hours making it 0200Hrs, 0400Hrs etc. We prepare these files daily after every 2 hours. Sometimes it does happen that we run the file after 3 hours making it 0500Hrs instead of 0400Hrs just after 0200Hrs. What I need is a VBA file which opens all these 12 files and in column A in the last row of each respective file, it mentions the name of that particular file.
Eg. it should open all 12 files and then in the first file named Cash Report as on 11-05-2017, in the last row of column A of this file - it should mention the name of this particular file.
So if the VBA opened file "Cash Report as on 11-05-2017 0400Hrs" then in the last cell of the column A just after the text or data in the cell, using offset the very below blank cell should have the name of this file as "Cash Report as on 11-05-2017 0000Hrs". Likewise, need something like this for all the files which open up each individual file and update the respective file name inside the last row of column A.
I was trying some of the codes but it's still in bits and pieces.
Dim Source As String
Dim StrFile As String
'do not forget the last backslash in the source directory.
Source = "C:\Users\Admin\Desktop\VBA\"
StrFile = Dir(Source)
Do While Len(StrFile) > 0
Workbooks.Open Filename:=Source & StrFile
StrFile = Dir()
Loop
fldr = Activeworkbook.Path
Dt = Application.InputBox("Enter Date as 'dd-mm-yyyy' ", format(Now," dd-mm-yyyy"
Workbooks.open Filename:= fldr & "\Cash Report as on" & 0400 & "Hrs.xlsx"
Range("A1").End(xlDown).Select
Offset(1).Select
Try This
Sub t()
Dim Source As String
Dim StrFile As String
Dim wb As Workbook
'do not forget last backslash in source directory.
Source = "C:\Users\Admin\Desktop\VBA\"
StrFile = Dir(Source)
Do While Len(StrFile) > 0
Set wb = Workbooks.Open(Source & StrFile)
wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = wb.Name
StrFile = Dir()
wb.Close (True)
Loop
End Sub
Try something like this.
Assumptions:
The Excel file name will be pasted always in the first Sheet - in case the specific sheets are naming always in the same way change lines Sheets(1) with Sheets("YourName")
Every row in table from column A in Sheets(1) is not empty as I'm using COUNTA function (thx #Darren Bartrup-Cook)
Code:
Sub InsertFileName()
Dim strFolderPath As String
Dim lngLastRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim ErrNumbers As Integer
'Choose folder with Excel files
strFolderPath = GetFolder(ThisWorkbook.Path) & "\"
'Loop through all Excel files in FolderPath
FileName = Dir(strFolderPath & "*.xl*")
Do While FileName <> ""
'Open Excel file
Set WorkBk = Workbooks.Open(strFolderPath & FileName)
'Find the last row in A column
On Error Resume Next
lngLastRow = Application.WorksheetFunction.CountA(WorkBk.Sheets(1).Range("A:A")) + 1
If lngLastRow = 1 Then
ErrNumbers = ErrNumbers + 1
Err.Clear
GoTo NextWkb
End If
WorkBk.Sheets(1).Range("A" & lngLastRow).Value = WorkBk.Name
NextWkb:
'Close file and save changes
WorkBk.Close True
'Next file
FileName = Dir()
Loop
If ErrNumbers <> 0 Then
MsgBox "There were some problems with Excel files. Check if there is some empty sheet or empty A column in one or more Excel files and try again"
Else
MsgBox "Everything went fine!"
End If
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Editing multiple excel files which are in different folders all united in one folder

I have 200 folders all with different names in a folder. Now, each folder with a different name has a macro excel file (.xlsm). I'm trying to edit all the files at once with a separate file. The code goes like this:
Sub Button1_Click()
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim strPath As String
Dim strFile As String
'Get the directories
strPath = "C:\Users\generaluser\Desktop\testing main folder\"
strFile = Dir(strPath)
'Loop through the dirs
Do While strFile <> ""
'Open the workbook.
strFileName = Dir(strPath & strFile & "*.xlsm")
'Open the workbook.
Set wb = Workbooks.Open(Filename:=strPath & strFile & "\" & strFileName , ReadOnly:=False)
'Loop through the sheets.
Set ws = Application.Worksheets(1)
'Do whatever
ws.Range("A1").Interior.ColorIndex = 0
'Close the workbook
wb.Close SaveChanges:=True
'Move to the next dir.
strFile = Dir
Loop
End Sub
But this doesn't work. I have tried tweaking it but whatever i do either does nothing or causes an error. Can someone please help me get this code to work.
(also: "testing main folder" is the folder on my desktop which holds the 200 other folders which hold the .xlsm files.)
Put Option Explicit at the top of the module. You'll get some compiler errors, one of them being that strFileName isn't declared. This would have been a great clue as to where to look, because the problem is that you're using two variable names that have roughly the same meaning when you read them, and they're getting mixed up.
After you're done fixing the variables, take a look at the documentation for the Dir function. The second issue is that you're also calling Dir multiple times in the loop, which means that you're skipping results.
It should look something more like this:
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim file As String
'path never changes, so make it a Const
Const path = "C:\Users\generaluser\Desktop\testing main folder\"
'This returns the first result.
file = Dir$(path & "*.xlsm")
Do While file <> vbNullString
Set wb = Workbooks.Open(Filename:=path & file, ReadOnly:=False)
Set ws = Application.Worksheets(1)
'Do whatever
wb.Close SaveChanges:=True
'This returns the next result, or vbNullString if none.
file = Dir$
Loop

VBA saveas newly created Excel sheet using old Word Document's title

I can create a new workbook by using the method
workbooks.add
However, I need to save it with the same file name as the previous Word document which I manually copied all the useful data into it.
I have done some research into this and have found out about this method in VBA called
saveas
but whenever I try, it fails to save the new file with the same name as the Word document.
This was my code...
Dim wdFileName As Variant
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Workbooks.Add
MyPath = "D:\Analysis\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'this line below selects the word file to be chosen
MyFile = Dir(MyPath & "*.docx", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each word file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
'Get the next word file from the folder
MyFile = Dir
Loop
wdFileName = MyPath & LatestFile
(extra code here)
(extra code here)
ActiveWorkbook.SaveAs Filename:=wdFileName, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
(the last 2 lines of code do not seem to have any effect at all and it does not save the Excel with the same title name as the Word document I get my data from)
As I'm still new in VBA, help would be much appreciated with thanks!
Please do provide clear code to aid in my learning.

Syntax to recognize the contents of a cell as a filename

I have written an Excel macro to copy pdf files from a source folder to a destination folder. I am now trying to incorporate a Do Loop into the macro so I can move multiple files, each of which are identified in a separate cell. Also, the quantity of files to be moved will vary.
When I use the command line
sFile = Range("G14").Value & ".pdf"
it does copy the file listed in cell G14 to the destination folder. However, I am having no luck using the Do Loop and sFiles = Cells (I,7) to increment through the series of filenames that I want to move. The macro bombs out on the final step.
Any suggestions would be appreciated.
Sub Copying_File()
Sheets("Sheet1").Select
I = 8
Do
I = I + 1
If Cells(I, 7) = "zzzz" Then Cells(I, 8) = "Transfer of Files Complete"
If Cells(I, 7) = "zzzz" Then Exit Do
'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
'This is Your File Name which you want to Copy
sFile = Cells(I, 7).Value & ".pdf"
'Change to match the source folder path
sSFolder = "I:\PatschB\ZZZ Source\"
'Change to match the destination folder path
sDFolder = "I:\PatschB\ZZZ Destination\"
'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Copying File to Destination Folder
FSO.CopyFile (sSFolder & sFile), sDFolder
Loop
End Sub
CopyFile requires two full paths - both should include the file name
Try replacing this line:
FSO.CopyFile (sSFolder & sFile), sDFolder
with this line:
FSO.CopyFile sSFolder & sFile, sDFolder

VBA - Trying to open all workbooks in a folder

I'm trying to loop through and open all files in a folder named (BU) located in the same directory as the sheet where my macro is. I am able to see the myfile get the first file name correctly, but I am getting a run time error 1004 when the workbook tries to open. Any help would be appreciated.
Sub LoopAndOpen()
Dim myfile As String, Sep As String, stringA As String, path1 As String
Sep = Application.PathSeparator
path1 = ActiveWorkbook.Path & Sep & "BU" & Sep
myfile = Dir(path1 & "*.xlsm")
Do While myfile <> ""
Workbooks.Open myfile
myfile = Dir()
Loop
End Sub
Edit: I ended up using Unicco's procedure and it worked perfectly.
You can use this procedure instead.
Modify "ThisWorkbook.Path" and ".xlsm" to your desired purpose. Use InStr(objFile, ".xlsm") Or InStr(objFile, ".xlsx") if you want to open both standard aswell as Excelfiles with macros.
Option Explicit
Sub OpenAllFiles()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
For Each objFile In objFolder.Files
If InStr(objFile, ".xlsm") Then
Workbooks.Open (objFile)
End If
Next
End Sub
Dir() only returns the file name, not the full path: you need to pass the full path to Open() unless the current directory happens to be the one you're searching through. It's best never to rely on that being the case.