Open FileDialog using VBA - excel

I download reports on a daily/weekly basis but when downloading the system auto generates the file name with a date at the end although the basic file name is the same. ie ANAPOS - 20141001. I'm using a simple open command (Workbooks.OpenText Filename:="C:\Users\903270\Documents\Excel\ANAPOS.txt") to do some other stuff but before doing so I need to rename the file to ANAPOS.txt before I can run it.
Is there any code that will allow my macro to search for ANAPOS with out all the other info at the end?
Any help appreciated.

Set filePath to where you want to search
Sub getANAPOS()
Dim Filter As String, filePath As String
filePath = "C:\Data\VBA\SO\"
Filter = "ANAPOS files (*.txt), filepath & ANAPOS*.txt"
ANAPOSSelectedFile = Application.GetOpenFilename(Filter)
End Sub
EDIT FOLLOWING CLARIFICATION BY OP
Sticking with the same theme, this should give you some scope to work with. It essentially 'automatically' renames the selected file in situ, unless it already exists. Acknowledgements to #Gary's Student for his neat ideas to parse the GetOpenFileName result, here.
Sub renameANAPOS()
Dim Filter As String, filePath As String, newName As String
'filter txt file names containing 'ANAPOS'
Filter = "ANAPOS files (*.txt), filepath & ANAPOS*.txt"
'the 'rename' name
newfName = "ANAPOS"
'navigate to original ANAPOS file and location details
ANAPOSSelectedFile = Application.GetOpenFilename(Filter)
'parse selected file details
fullArr = Split(ANAPOSSelectedFile, "\")
detArr = Split(fullArr(UBound(fullArr)), ".")
fullArr(UBound(fullArr)) = ""
fPath = Join(fullArr, "\")
fName = detArr(0)
fExt = detArr(1)
'rename file in not already exixts
If Len(Dir(fPath & newfName & "." & fExt)) > 0 Then
MsgBox newfName & "." & fExt & " already exists in this folder."
Exit Sub
Else
Name ANAPOSSelectedFile As fPath & newfName & "." & fExt
End If
End Sub

Related

VBA opening a file with partial name

I am trying to open a file which will be updated periodically. The current name is "GDE Portfolio Characteristics 12.31.2021" and the idea is to instruct the code to open it, no matter the date (i.e. the last 10 characters). I should only have one file in the folder with such a partial name.
The code I use is the following:
Workbooks.Open Filename:=ThisWorkbook.Path & "\Parametric GDE Portfolio Characteristics*.xlsx"
When running it, it seems it does not find the file. It works if I instead use the entire name of the file.
Newbie problem, but scratching my head in frustration!
Many thanks
There is no way to use a wildcard in the Open-statement. However, you can use the
Dir-command to get the real file name as it allows wildcards:
Dim fileName As String
fileName = Dir(ThisWorkbook.Path & "\Parametric GDE Portfolio Characteristics*.xlsx")
If fileName <> "" Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & fileName
End If
Here is a more generic approach:
Sub OpenFiles()
Dim Files As Collection
Set Files = ListFiles(ThisWorkbook.Path, "Parametric GDE Portfolio Characteristics*.xlsx")
Dim Filename As Variant
For Each Filename In Files
Workbooks.Open Filename:=Filename
Next
End Sub
Function ListFiles(FolderName As String, SearchString As String) As Collection
Set ListFiles = New Collection
Dim Filename As String
Filename = Dir(FolderName & "\" & SearchString)
If Len(Filename) = 0 Then Exit Function
Do While Filename <> ""
ListFiles.Add Filename
Filename = Dir()
Loop
End Function

How can I convert a CSV file to XLSM while renaming the file from the file path?

Another user greatly helped me with this but I am stuck on a few parts.
The purpose of the macro:
The purpose is to take the fifth element number in the current file path then rename the file with that number and a string following it. Then I want to convert it to CSV from XLSM
The comments I have outlined explain what each block code's description is. I am not sure how to change it so that I need not to use CONST since I want to find a variable that is found at run-time and const only uses compile-time.
Const original is meant to be assigned the current workbook. I do not want a hardcoded file path in the macro.
Ensuring that the xlsm copy is left alone but renamed so that it matches XLSM
There will be a CSV copy and a XLSM copy
The file path that I have been testing on is R:\3.0 Projects\2.0 Current Projects\2021 JOBS\999111-DO-Customer-Description\2.0 Estimate\2.7 Final Estimates\FoundationImport-TMP-IFI-REV12.XLSM
I want the final file to be " R:\3.0 Projects\2.0 Current Projects\2021 JOBS\999111-DO-Customer-Description\2.0 Estimate\2.7 Final Estimates\999111import-TMP-IFI-REV12.XLSM
I appreciate your guys help greatly!
Function getName(pf): getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0): End Function
Sub Snippet()
Const Original As String = "R:\3.0 Projects\2.0 Current Projects\2021 JOBS\999111-DO-Customer-Description\" & _
"2.0 Estimate\2.7 Final Estimates\FoundationImport-TMP-IFI-REV12.XLSM"
'Original = getName(ActiveWorkbook.FullName)
Dim Ext As String ' file extension
Dim Fn As String ' file name
Dim Path As String ' file path
Dim Ffn As String ' full file name
Dim Sp() As String
Dim CSVfile
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Foundation Budget Template")
' extracts number from 5th element and applies to file name
Sp = Split(Original, "\")
Fn = Sp(UBound(Sp))
Sp(7) = Split(Sp(4), "-")(0) & "import-TMP-IFI-REV12"
Ffn = Join(Sp, "\")
MsgBox "Original Ffn: " & Original & vbCr & vbCr & _
"Changed 5th element: " & Ffn
'Convert file from XLSM to CSV
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CSVfile, FileFormat:=xlCSV, local:=True
' append a file name to path
Sp = Split(Path, "\")
Fn = "My File Name" & "." & Ext
ReDim Preserve Sp(UBound(Sp) + 1)
Sp(UBound(Sp)) = Fn
Ffn = Join(Sp, "\")
MsgBox "Full File Name = " & Ffn
End Sub

VBA, File path dynamic date

I have a file that is placed in a folder, but the date is unknown to me, is there anyway I can pick it up regardless of the date?
FilePath = "\\0_Received\Business_Level_Report_yyyymmdd.xlsx"
The file name will be for example Business_Level_Report_20200729
The date will be unknown but it is the only file with Business Level Report as its prefix.
Can anyone help with this?
Maybe try this solution here: VBA partial file name
You can likely modify this just a bit to get what you're looking for.
For example, in your case you might try this:
myPath = "\\0_Received\"
fname = Dir(myPath & "Business_Level_Report*")
For example, this code opens the workbook named Business_Level_Report_blah_blah_blah without having to specify blah_blah_blah:
Here's the code if you want to run it, too:
Private Sub whatever()
Dim fname As Variant
Dim myPath As String
myPath = "C:\Users\beckj\"
fname = Dir(myPath & "Business_Level_Report*")
If fname <> "" Then
Workbooks.Open (myPath & fname)
MsgBox "File is open."
Else
MsgBox "ERROR."
End If
End Sub
For taday:
FilePath = "\\0_Received\Business_Level_Report_" & Format(Date, "yyyymmdd") & ".xlsx"
for "07/29/2020"
Dim D as Date
D = cDate("07/29/2020")
FilePath = "\\0_Received\Business_Level_Report_" & Format(D, "yyyymmdd") & ".xlsx"
Or if you do not care about a specific date, you must iterate between the folder workbooks and choose the appropriate one in this way:
If fileName like "*Business_Level_Report########.xlsx" then
FilePath = fileName
End If

Excel Macro saving file to the wrong directory

I have looked at quite a lot of similar questions, but none of them seem to work for my specific issue.
I have a macro that saves my file with a new name if it encounters a file with the same name.
What keeps happening is that it saves the original file to the correct folder, but then when it encounters the file name the next time I save it, the instanced file gets saved to the same folder as the template rather than the folder that they should go to.
In the example below, my template file is saved in the "M:\Excel\" directory.
It saves the first "TEST" file into the "M:\Excel\SavedVersions\" directory since the file name doesn't exist yet.
Then when I run the macro again to have it automatically save an instanced version (ie - "TESTrev1"), it keeps saving the instanced versions to the "M:\Excel\" directory instead of saving it to the "SavedVersions" subfolder.
Not sure what needs to be changed or done differently to get the instanced versions to save to the correct folder.
Any help would be greatly appreciated!
Thanks in advance! :)
Sub TEST()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
GetNextAvailableName("M:\Excel\SavedVersions\TEST.xlsm")
End Sub
Function GetNextAvailableName(ByVal strPath As String) As String
With CreateObject("Scripting.FileSystemObject")
Dim strFolder As String, strBaseName As String, strExt As String, i As Long
strFolder = .GetParentFolderName("M:\Excel\SavedVersions\")
strBaseName = .GetBaseName("TEST")
strExt = .GetExtensionName(".xlsm")
Do While .FileExists(strPath)
i = i + 1
strPath = .BuildPath(strFolder, strBaseName & "rev" & i & "." & strExt)
Loop
End With
GetNextAvailableName = strPath
End Function
Your code was unnecessarily complex.
Try this simpler version.
Sub TEST()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs fileName:= _
GetNextAvailableName("M:\Excel\SavedVersions\TEST.xlsm")
End Sub
Function GetNextAvailableName(ByVal strPath As String) As String
Dim i as Interger: i = 0
Do Until Len(Dir(strPath)) = 0
i = i + 1
strPath = "M:\Excel\SavedVersions\TESTrev" & i & ".xlsm"
Loop
GetNextAvailableName = strPath
End Function
Keep your code simple. If your path is constant then might as well define a variable for it so that it can be used whenever and whereever you want. This way if there is any change in the path, you have to make the change at only one place.
While saving the file, also specify the FileFormat parameter to avoid problems. You might want to read more about it HERE
Is this what you are trying?
Option Explicit
Const sPath As String = "M:\Excel\SavedVersions\"
Sub Sample()
Dim flName As String
flName = sPath & GetNextAvailableName()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=flName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
Function GetNextAvailableName() As String
Dim i As Integer: i = 1
Dim newFile As String
newFile = "TestRev" & i & ".xlsm"
Do Until Dir(sPath & newFile) = ""
i = i + 1
newFile = "TestRev" & i & ".xlsm"
Loop
GetNextAvailableName = newFile
End Function

Save numbered versions of excel files based on folder contents

I need code that saves incrementally numbered versions of a file based on whether similarly named files already exist in a specified folder.
For example,
Check for the prescence of currently open file, say named
"Inv_Dec_2015.xlsx" in a folder named "Reports".
If file exists, check for "Inv_Dec_2015_v1.xlsx" in "Reports".
If file exists, check for "Inv_Dec_2015_v2.xlsx" in "Reports".
If file exists, check for "Inv_Dec_2015_v3.xlsx" in "Reports".
If file does NOT exist, Save currently open file as "Inv_Dec_2015_v3.xlsx"
and so on till any number of versions......
I found the following two pieces of code on Ron de Bruin's website that can be used for something like this and modified it a bit to my purpose, but I don't know how use it to check for pre-existing files.
Would deeply appreciate any help with this.
Sub Rename_Store_Wbk()
Dim sPath As String
' Enter the path at which file is to be stored
sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"
' Check whether the file already exists by calling the FileExist function
If FileExist(sPath) = False Then
ActiveWorkbook.SaveAs Filename:=sPath, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub
Function FileExist(FilePath As String) As Boolean
Dim TestStr As String
'Test File Path (ie "C:\Users\Chris\Reports\Inv_Dec_2015.xlsm")
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'Determine if File exists
If TestStr = "" Then
FileExist = False
Else
FileExist = True
End If
End Function
See if the loop I added in here works for you:
Sub Rename_Store_Wbk()
Dim sPath As String
' Enter the path at which file is to be stored
sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"
If Not FileExists(sPath) Then
i = 1
Do
sPath = Left(sPath, Len(sPath) - 5) & "_v" & i & ".xlsx"
i = i + 1
Loop Until FileExists(sPath)
End If
ActiveWorkbook.SaveAs Filename:=sPath, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

Resources