How to select the last part of a string with VBa? - excel

I'm trying to name a text file created by my code.
the text file is a formated version of another text file.
Let's say i have file A: original file, and file B: formated file.
file B is created by my VBa code and i want to name file B : formate + "file A"
here's my code:
Dim order As Object
Dim Folder As Object
Dim Folder_path As String
Dim lastrow As Long
Dim fSo As Object
Dim myFile As Object
MsgBox InStrRev(Sheets(8).Cells(6, 12).Value, "\")
FolderName = "Formated Files"
Filename = "formated " & Right(Sheets(8).Cells(6, 12).Value, InStrRev(Sheets(8).Cells(6, 12).Value, "\")
[...]
Folder_path = FL + "\" + FolderName
Set fSo = CreateObject("Scripting.FileSystemObject")
If Not fSo.FolderExists(Folder_path) Then
fSo.CreateFolder (Folder_path)
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)
myFile.WriteLine "Error"
myFile.Close
Set fSo = Nothing
End If
Else
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)
for now i'm trying to get the name of the file B by using the path of the file A (so i need to get the last part of the path witch is the name of file A) and adding "formated" to it.
If you see a better way to get that name or if you find a way to simplify my code feel free to help.

If your filename looks something like this:
C:/documents/docs/filename.txt
And you want to append a word before the .txt:
C:/documents/docs/filename_suffix.txt
the easiest way is probably:
newfilename = Replace(filename,".txt","_suffix.txt",,,1)
However, if you wanted to append a word before the start of the file's name:
C:/documents/docs/prefix_filename.txt
then you could use FSO's GetBaseName in a replace
filebase=fso.getbasename(filename) & "."
newfilename = Replace(filename,filebase,"prefix_" & filebase,,,1)

Related

Pull data from most recent file in folder

Trying to use the most recent file in folder for data.
My problem is that my master excel file wont use the data from the most recent data file (xlsx) to pull the data. My code currently has the name of the current file (eg. "Network-2019.xlsm") but lets say i insert a file called "network.xlsm, which is posted in the folder later. I want main dataset to recognize this and pull in that data.
Function GetMostRecentExcelFile(ByVal myDirectory As String, ByVal filePattern As String) As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim myFolder As Object
Set myFolder = fso.getfolder(IIf(Right(myDirectory, 1) = "\", myDirectory, myDirectory & "\"))
Dim currentDate As Date
Dim fname As String
Dim currentFile As Object
For Each currentFile In myFolder.Files
If (currentDate = CDate(0) Or currentFile.DateCreated > currentDate) And currentFile.name Like filePattern _
And InStr(LCase$(currentFile.name), ".xlsx") > 0 And InStr(currentFile.name, "~$") = 0 Then
currentDate = currentFile.DateCreated
fname = currentFile.name
End If
Next currentFile
GetMostRecentExcelFile = fname
End Function
I would suggest something like below, since you are using the FileSystemObject
Note that I used early binding. The associated intellisense is quite useful, and you can always change to late binding if you need to for any reason.
Option Explicit
Function GetMostRecentExcelFile(sFolderPath As String) As String
Dim FSO As FileSystemObject
Dim FO As Folder, FI As File, recentFI As File
Set FSO = New FileSystemObject
Set FO = FSO.GetFolder(sFolderPath)
For Each FI In FO.Files
Select Case FI.Name Like "*.xlsx"
Case True
Select Case recentFI Is Nothing
Case True
Set recentFI = FI
Case False
If FI.DateCreated > recentFI.DateCreated Then
Set recentFI = FI
End If
End Select
End Select
Next FI
GetMostRecentExcelFile = recentFI.Path
End Function

Open file which do not have standard name

Suppose, we have one folder with only one macro file and every day we are saving excel file in the same folder received via mail. However, filename every day will get changed. I mean to say what ever file we are getting through mail do not have a standard name. Now, we have two files in the same folder.
Can we open another file which we have saved with some random name available in the same folder using a macro? Here, the name of another file is not standard. Additionally, after running a macro, we also want to delete that file.
You can get the filename of the newest file within a directory by this:
Option Explicit
Private Sub GetNewestFilename()
Dim searchDirectory As String
Dim searchPattern As String
Dim currentFilename As String
Dim NewestFilename As String
Dim NewestFiledate As Date
searchDirectory = Application.DefaultFilePath & "\"
searchPattern = "*.xl*"
currentFilename = Dir(searchDirectory & searchPattern, 0)
If currentFilename <> "" Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
Do While currentFilename <> ""
If FileDateTime(searchDirectory & currentFilename) > NewestFiledate Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
End If
currentFilename = Dir
Loop
End If
MsgBox NewestFilename
Dim wb As Workbook
Set wb = Workbooks.Open(searchDirectory & NewestFilename)
' do something
wb.Close SaveChanges:=False
Set wb = Nothing
' Kill searchDirectory & NewestFilename ' Delete the file
End Sub

how to read a text using condition if

I have an issue and I need your help. here is the problem. I have inside a folder some excel files that I have to open automatically in order to make some operations. Those files have the same name except the number of the files like this:
Folder name : Extraction_Files
Files name : - "System_Extraction_Supplier_1"
- "System_Extraction_Supplier_2"
- "System_Extraction_Supplier_3"
The number of files can change so i used a loop Do While to count the number of files, then the plan is to use a loop for I =1 to ( number of files) to open all of theme.
please read my code. I know that i used a wrong way to read file name using a loop for but I share it because I don't have an other idea.
Here is my code :
Sub OpenFiles ()
Dim MainPath as String
Dim CommonPath as String
Dim Count As Integer
Dim i As Integer
' the main path is " C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
'with i = 1 to Count ( file number )
CommonPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_*"
'counting automatically the file number
Filename = Dir ( CommonPath )
Do While Filename <> ""
Count = Count + 1
Filename = Dir ()
Loop
'the issue is below because this code generate a MsgBox showing a MainPath with the index i like this
'"C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
' so vba can not find the files
For i = 1 To count
MainPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_" & "i"
MsgBox MainPath &
Workbooks.Open MainPath
Next
End Sub
what is the best approach to this?
Why not count as you open them. You're already identifying them so why not open each file as you go:
Sub OpenFiles()
Dim Filename As String
Dim CommonPath As String
Dim Count As Integer
CommonPath = "C:\Desktop\Extraction_Files\"
Filename = Dir(CommonPath & "System_Extraction_Supplier_*")
Do While Filename <> ""
MsgBox Filename
Workbooks.Open CommonPath & Filename
Count = Count + 1
Filename = Dir()
Loop
End Sub
PS. It might be worth adding .xl* or similar to the end of your search pattern to prevent Excel trying to open files that aren't Excel files:
Filename = Dir(CommonPath & "System_Extraction_Supplier_*.xl*")
If you want to open all folders, in a specific folder, which start with "NewFile_", one loop only is needed:
Sub OpenFolders()
Dim path As String: path = ""C:\Desktop\Extraction_Files\""
Dim fileStart As String: fileStart = "System_Extraction_Supplier_"
Dim Fso As Object
Dim objFolder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = Fso.GetFolder(path)
For Each objSubFolder In objFolder.subfolders
If InStr(1, objSubFolder.Name, fileStart) Then
Shell "explorer.exe " & objSubFolder, vbNormalFocus
Debug.Print objSubFolder.Name
End If
Next objSubFolder
End Sub
Folders in vba are opened with the Shell "explorer.exe " command. The code opens every folder in "C:\yourFile\", which contains NewFile_ in the name. This check is done with If InStr(1, objSubFolder.Name, fileStart) Then.

A vbs script to remove annotation

I have a basic vbs code to split a file name at the first underscore. Eg:t_e_s_t becomes t.
I dont want to split the file name, I want to remove the annotation of the file name
that would consist out of "." "_" and spaces.
Please can someone just have a look at the code and tell me how to modify it?
Option Explicit
Dim strPath
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Dim strFileParts
'Define the path to the file
strPath = inputbox("File path:")
'Create the instance of the FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set the folder you want to search. NOTE - some antivirus may not like this
Set FLD = FSO.GetFolder(strPath)
'Loop through each file in the folder
For Each fil in FLD.Files
'Get complete file name with path
strOldName = fil.Path
'Check the file has an underscore in the name
If InStr(strOldName, "_") > 0 Then
'Split the file on the underscore so we can get everything before it
strFileParts = Split(strOldName, "_")
'Build the new file name with everything before the
'first under score plus the extension
strNewName = strFileParts(0) & ".txt"
'Use the MoveFile method to rename the file
FSO.MoveFile strOldName, strNewName
End If
Next
'Cleanup the objects
Set FLD = Nothing
Set FSO = Nothing
How about:
strNewName = Replace(strOldName, "_", "") & ".txt"
Instead of publishing code that does not do what you want, you should specify exactly what input should be transformed to what output. E.g: "t e.s_t" should become "test". Then it would be easy to come up with some proof of concept code:
>> Function qq(s) : qq = """" & s & """" : End Function
>> Function clean(s)
>> clean = Replace(Replace(Replace(s, " ", ""), ".", ""), "_", "")
>> End Function
>> a = Array("test", "t e s t", "t_e.s t")
>> For i = 1 To UBound(a)
>> c = clean(a(i))
>> WScript.Echo qq(a(i)), qq(c), CStr(c = a(0))
>> Next
>>
"t e s t" "test" True
"t_e.s t" "test" True
>>
and really interesting questions like:
Why apply the modification to the full path (strOldName = fil.Path)?
What should happen to the dot before the extension?
Use a regular expression:
Set re = New RegExp
re.Pattern = "[._ ]"
re.Global = True
For Each fil in FLD.Files
basename = FLD.GetBaseName(fil)
extension = FLD.GetExtensionName(fil)
fil.Name = re.Replace(basename, "") & "." & extension
Next
If you want to mangle the extension and append a new extension .txt to each file regardless of type use this loop instead:
For Each fil in FLD.Files
fil.Name = re.Replace(fil.Name, "") & ".txt"
Next

How do I check a directory for a file name given by an InputBox in VBA?

My code asks the user to input a file name. We'll say we have 5 text files in directory "C:\Users\aUser\Desktop\myFolder". These text files are named A, B, C, D, and E.
If the text file exists, then I would like to write over the contents with a script I've already made. If the text file does not exist, I would like to make one with the file name they inputted, and populate it [with the script I've already written].
Thanks for your help.
The way you explain it, it seems that the easiest workflow would be:
1) Delete the file if exists
Sub test()
Dim FSO As FileSystemObject
Dim sPath As String
sPath = "U:\Test.txt"
Set FSO = New FileSystemObject
If FSO.FileExists(sPath) Then
FSO.DeleteFile (sPath)
End If
End Sub
Copy the script (I assume also a txt file) into the path:
FileCopy "U:\Script", sPath
If you have the script in a string variable:
Set txtFile = FSO.CreateTextFile(sPath, True)
txtFile.WriteLine(sText)
FSO.Close
End Sub
If the script is contained in an array, you can loop through the array and produce multiple writelines.
Don't forget to reference the Microsoft Scripting Runtime library.
Something like this
locates the folder for the logged on user regardless of OS
checks that the user input file is contained in a master list (held by StrFiles)
then either creates a new file if it doesn't exist, or
provides a logic branch for you to add your overrwrite script
Sub
code
GetFiles()
Dim wsShell As Object
Dim objFSO As Object
Dim objFil As Object
Dim strFolder As String
Dim StrFile As String
Dim StrFiles()
StrFiles = Array("A.txt", "B.txt", "C.txt")
Set wsShell = CreateObject("wscript.shell")
strFolder = wsShell.specialFolders("Desktop") & "\myFolder"
StrFile = Application.InputBox("Please enter A.txt, B.txt", "File Selection", , , , , 2)
If IsError(Application.Match(StrFile, StrFiles, 0)) Then
MsgBox StrFile & " is invalid", vbCritical
Exit Sub
End If
If Len(Dir(strFolder & "\" & StrFile)) = 0 Then
'make file
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFil = objFSO.createtextfile(strFolder & "\" & StrFile, 2)
objFil.Close
Else
'write over file
'add your code here
End If
End Sub

Resources