I'm completely new to VBA and had some trouble googling this problem cause variable has multiple meanings.
I am trying to open a file and assign its name to a variable. The file's name is never the same though I always download it to the same folder (one file in that folder only). The only recognizable thing about the file are 3 letters "ABC".
So far I managed to get opening the file to work but not assigning the non-standardized file name to a variable.
Sub openwb()
Dim wb As Workbook Dim directory As String
directory = "D:\Users\AAA\Desktop\Practice"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(directory)
For Each file In folder.Files
If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xlsm" Then
Workbooks.Open directory & Application.PathSeparator & file.Name
End If
Next file
End Sub
Public Sub RecordFileName()
Dim sPath As String, sFile As String
Dim wb As Workbook
sPath = "D:\Users\AAA\Desktop\Practice"
sFile = sPath & "*ABC*"
End Sub
Here is a function you can use. It will return the filename you are looking for, and you can specify a file pattern if you want to, or you can omit that argument and it will assume all files.
Function GetFullFileName(sFolder As String, Optional sPattern As String = "*") As String
Dim sFile As String
' ensure sFolder ends with a backslash
If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
sFile = Dir(sFolder & sPattern)
If sFile = "" Then
MsgBox "NOT FOUND: " & sFolder & sPattern
End
End If
GetFullFileName = sFolder & sFile
End Function
Usage:
MsgBox GetFullFileName("C:\Users\Fred\Documents")
Or
MsgBox GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")
Or
sFullFile = GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")
Related
I have the following code to open a file that contains a number that is usually ten digits.
I would like the code to refer to my worksheet for that number rather than mentioning it in the code.
When I try the Range formula, it doesn't work because the number is too large to be stored as an integer. If I store this number as text, it's not able to locate the file.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "H:\Test\" 'EXACT folder name containing the files.
'Change to suit, but don't forget the trailing backslash '\'
MyFile = Dir(MyFolder & "\*2964179000*.xlsm")
Do Until MyFile = ""
Workbooks.Open Filename:=MyFolder & "" & MyFile
MyFile = Dir
Loop
End Sub
If you need to store long numbers on the sheet then format the cell(s) as Text before adding their content.
You should be able to do something like this:
Sub OpenFiles()
Dim MyFolder As String, ws As Worksheet
Dim MyFile As String
Set ws = ThisWorkbook.Worksheets("Info") 'for example
MyFolder = "H:\Test\"
MyFile = Dir(MyFolder & "*" & ws.Range("A10").Value & "*.xlsm")
Do Until MyFile = ""
Workbooks.Open Filename:=MyFolder & "" & MyFile
MyFile = Dir
Loop
End Sub
The title might be confusing.
What I meant was, say I have the path and file saved under a variable.
sPath = "C:\Users\"
sFile = "*1234*.*"
sWorkbook = sPath & sFile
The idea is that the sFile should be as vague as possible to account for any file names which may come through this folder. However, now that I have the file name saved under the sWorkbook variable, I have no idea how to open it by referencing sWorkbook; e.g. workbooks.open("sWorkbook").
Use the Dir function to get the filename you want
sPath = "C:\Users\"
sWildcard = "*1234*.*"
sFile = Dir(sPath & sWildcard)
If sFile <> "" Then
sWorkbook = sPath & sFile
Workbooks.Open sWorkbook
Else
Msgbox "File Not Found"
' Exit Sub '// optionally exit the subroutine so that it does not try to continue //
End If
I'm preparing a code which would every month help users rename specific string in multiple files.
Example: from "Jan" to "Feb", from "Bank" to "Cash", from "Test" to "Sharp" etc. (Bank Statement Jan.xls -> JPM Statement Jan.xls, Form test.xls -> Form sharp.xls, etc.)
I use a function to populate files from all folders and also subfolder picked up a FileDialog, then I prompt the user to InputBox string to be found and string to be replaced in the file name.
Sub testrenametest()
Dim filedlg As FileDialog
Dim xPath As String
Dim fileList As Object
Dim vFile As Variant
Dim FindTerm As String, ReplaceTerm As String, NewFileName As String
Set filedlg = Application.FileDialog(msoFileDialogFolderPicker)
With filedlg
.Title = "Please select folder"
.InitialFileName = ThisWorkbook.Path
If .Show <> -1 Then End
xPath = .SelectedItems(1) & "\"
End With
FindTerm = InputBox("Find string:") ReplaceTerm = InputBox("Replace with:")
Set fileList = getFileList(xPath)
For Each vFile In fileList
If vFile Like "*" & FindTerm & "*" Then
NewFileName = Replace(vFile, FindTerm, ReplaceTerm)
Name vFile As NewFileName
End If
Next vFile
End Sub
Function getFileList(Path As String, Optional FileFilter As String = "*.*", Optional fso As Object, Optional list As Object) As Object
Dim BaseFolder As Object, oFile As Object
If fso Is Nothing Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set list = CreateObject("System.Collections.ArrayList")
End If
If Not Right(Path, 1) = "\" Then Path = Path & "\"
If Len(Dir(Path, vbDirectory)) = 0 Then
MsgBox "You need to browse folder first!"
End
End If
Set BaseFolder = fso.GetFolder(Path)
For Each oFile In BaseFolder.SubFolders
getFileList oFile.Path, FileFilter, fso, list
Next
For Each oFile In BaseFolder.Files
If oFile.Path Like FileFilter Then list.Add oFile.Path
Next
Set getFileList = list
End Function
It works for some strings like month names but for instance for "test" or "bank" doesn't. It says Run-time error 53 File not found on line Name vFile As NewFileName, but the file exists. Sorry for inputting the whole code, but I am unable to pinpoint where might be a problem.
Your problem probably lies in the fact that it is attempting to rename a file inside the loop that no longer exists with that name. Condition the rename by first double-checking to make sure the file still exists.
For Each vFile In fileList
If vFile Like "*" & FindTerm & "*" Then
NewFileName = Replace(vFile, FindTerm, ReplaceTerm)
If Dir$(vFile) <> "" Then
Name vFile As NewFileName
End If
End If
Next vFile
Edit: after additional feedback was provided that the problem is that the replaced string was also found in the path, I suggest the following fix:
For Each vFileSpec In fileList
vPath = Left(vFile, InstrRev(vFileSpec, "\") - 1)
vFile = Mid(vFileSpec, Len(vPath) + 1)
If vFile Like "*" & FindTerm & "*" Then
NewFileName = Replace(vFile, FindTerm, ReplaceTerm)
Name vFileSpec As vPath + "\" + NewFileName
End If
Next vFile
I run this code daily that will affect each .xlsx workbook in the directory, but how can I ignore the workbook if the file name is not in the "Okay" array?
This is my current syntax:
Option Explicit
Public Sub OpenExcelInDir()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\ExcelSheets"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Call UpdateAllSheets
Loop
End Sub
Now I want to alter it so that I can declare a string array and only open the workbooks in the array something like so:
Dim goodWB() As String
goodWB= Split("ABC123,DEF456,GHI789", ",")
Even though I like the IsInArray function I think the algorithm is utterly inefficient. If you have 1000 files in that folder you will create 1000 temp arrays if one of the few given filenames match. Furthermore, I would expect that after opening one of the wanted files the code would not test against this name anymore (which is not the case).
Instead I propose to look at the problem from the other end:
Public Sub OpenExcelInDir()
Dim goodWB, filename
Dim MyFolder As String
Dim MyFile As String
goodWB = Array("ABC123.xls", "DEF456.xlsx", "GHI789.xlsx")
MyFolder = "C:\ExcelSheets"
For Each filename In goodWB
MyFile = MyFolder & "\" & filename
If Len(Dir(MyFile)) > 0 Then
Workbooks.Open filename:=MyFile
Call UpdateAllSheets
End If
Next WB
End Sub
Here, the Dir() function is used to test for the existance of the wanted filename in the specified folder. As an additional advantage there won't be any ambiguities like EEM mentioned in his/her comment.
I think this will do what you are asking for. I added a line to test if the file name matched one in the array.
Tested
Option Explicit
Public Sub OpenExcelInDir()
Dim goodWB() As String
goodWB = Split("ABC123.xlsx,DEF456.xlsx,GHI789.xlsx", ",")
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\ExcelSheets"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
If IsInArray(MyFile, goodWB) Then
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Call UpdateAllSheets
End If
MyFile = Dir
Loop
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Public Sub OpenExcelInDir()
Const kExt As String = ".xlsm" `As extension is fixed it could be defined as a constant to avoid repetition
Dim aWbks As Variant, vItm As Variant ‘Suggest to define the array in one step choose the form you prefer
‘aWbks = Array("ABC123", "DEF456", "GHI789")
aWbks = [{"ABC123", "DEF456", "GHI789"}]
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\ExcelSheets"
MyFile = Dir(MyFolder & "\*" & kExt)
Do While MyFile <> ""
For Each vItm In aWbks
If vItm & kExt = MyFile Then
Workbooks.Open Filename:=MyFolder & "\" & MyFile
Call UpdateAllSheets
Exit For
End If: Next
MyFile = Dir
Loop
End Sub
Can anyone please review code below and tell me where am I going wrong?
Basically what I am trying to achieve, user inputs name in the Column A, then will click upload button (same row, column F), excel would create a folder using name from Column A, via filedialog window user will select multiple files which should be copied to newly created folder, finally excel would also additionally create path to the folder (saved in column D) and stamp the date (column E).
Current problems:
Fails to copy multiple files, currently I can only copy one file
File is copied to parent folder of newly created folders, basically
fails to copy to newly created folder itself.
My code:
Sub Button1_Click()
Dim objFSO As Object
Dim objFile As Object
Dim openDialog As FileDialog
Dim Foldername As String
Dim Path As String
Dim Newpath As String
Dim i As Integer
Dim myfile As String
Dim myfilePath As String
Foldername = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -5).Value
Path = "C:\Test\"
Set openDialog = Application.FileDialog(msoFileDialogFilePicker)
openDialog.AllowMultiSelect = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To openDialog.SelectedItems.Count
myfile = openDialog.SelectedItems.Item(i)
Next
If openDialog.Show = -1 Then
If Dir(Path & Foldername, vbDirectory) = "" Then
MkDir Path & Foldername
End If
objFSO.CopyFile myfile, Path
ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2).Hyperlinks.Add ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2), Address:=Path & Foldername, TextToDisplay:="Open Folder"
ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -1).Value = Format(Now, "MM/dd/yyyy")
MsgBox "Files were successfully copied"
End If
End Sub
Your For loop was in the wrong place. This is why you were not able to loop through every file and copy it.
You have this problem, because you used objFSO.CopyFile myfile, Path instead of the newly created folder name. I changed that part with this: objFSO.CopyFile myfile, Path & Foldername & "\" . Note that Path & Foldername is not enough, as you need to have \ at the end.
The working code:
Sub Button1_Click()
Dim objFSO As Object
Dim objFile As Object
Dim openDialog As FileDialog
Dim Foldername As String
Dim Path As String
Dim Newpath As String
Dim i As Integer
Dim myfile As String
Dim myfilePath As String
Foldername = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -5).Value
Path = "C:\Test\"
Set openDialog = Application.FileDialog(msoFileDialogFilePicker)
openDialog.AllowMultiSelect = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
If openDialog.Show = -1 Then
If Dir(Path & Foldername, vbDirectory) = "" Then
MkDir Path & Foldername
End If
For i = 1 To openDialog.SelectedItems.Count
myfile = openDialog.SelectedItems.Item(i)
objFSO.CopyFile myfile, Path & Foldername & "\"
Next
ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2).Hyperlinks.Add ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2), Address:=Path & Foldername, TextToDisplay:="Open Folder"
ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -1).Value = Format(Now, "MM/dd/yyyy")
MsgBox "Files were successfully copied"
End If
Set objFSO = Nothing
Set openDialog = Nothing
End Sub