I need to have a button that once clicked will create a folder in a pre-specified directory. The folder in question would contain a number with the year and 3 additional numbers in sequence. Formatted like this "2022001 Folder Name Generated From Text Box Here"
Once the user clicks the button again it adds +1 to the next folder ID "2022002 Folder Name Generated From Text Box Here"
The number would have to be stored so it could pick up where it left off after the program is closed.
What is the best way to go about doing this? Could you share a snippit?
This works for me:
Dim year = DateTime.Now.Year
Dim regex = New Regex($"{year:0000}(\d{{3}})")
Dim nextNumber = _
Directory _
.EnumerateDirectories("D:\Temporary") _
.Select(Function(x) New DirectoryInfo(x)) _
.Select(Function(x) regex.Match(x.Name)) _
.Where(Function(x) x.Success) _
.Select(Function(x) Integer.Parse(x.Groups(1).Value)) _
.Max() + 1
Dim nextFolder = $"{year}{nextNumber:000}"
When I created these two folders 2022001 & 2022002 - Copy and ran this code it produced:
2022003
Related
I have a working code below opening and saving a PDF file for 1 specific user to documents folder.
The issue I do not know is how to replace specific user name like SmithJoe with any other user. The code should be used by more users. Now it doesn´t work when for example TaylorRog tries to use the code. It is working for SmithJoe only.
Is there any possibility to replace specific user "SmithJoe" with all users?
Sheets("ABC").Range("G8:j18").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\SmithJoe\Documents\fileA.pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=True
Thank you in advance
To get the content of an Windows environment variable, use the function Environ.
To get the username, use Environ("USERNAME").
But note that there are cases where the name of the folder is not equal to the name of the user or the location of the folder is different from C:\Users. It's better to use Environ("USERPROFILE") - in your case that should return C:\Users\SmithJoe.
But of course that's not the full story. The documents-folder could have a different name or it could be in a different place. To be on the save side, you need to query the folder. There are several ways to do so, I found the following method the easiest:
Function GetSystemFolder(folderID) As String
On Error Resume Next
Dim f
Set f = CreateObject("Shell.Application").namespace(folderID)
On Error GoTo 0
If Not f Is Nothing Then GetSystemFolder2 = f.Self.path
End Function
The parameter folderID tells the function which folder you want, the document folder has the value 5. A list of all ids can be found at Microsoft.
You code could look like this
Const ssfPERSONAL = &H5
...
Dim pdfFilename as String
pdfFilename = GetSystemFolder(ssfPERSONAL) & "\fileA.pdf"
Sheets("ABC").Range("G8:j18").ExportAsFixedFormat Type:=xlTypePDF,
Filename:= pdfFilename , Quality:= xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
thanks a lot.
May I have another question? To make the code work, I need to:
create this function:
Function GetSystemFolder(folderID) As String
create the Sub macro with the code
Const ssfPERSONAL = &H5
...
Dim pdfFilename as String
pdfFilename = GetSystemFolder(ssfPERSONAL) & "\fileA.pdf" etc.
What content should be instead of the three dots? Const ssfPERSONAL = &H5 ... Dim pdfFilename as String
I am trying to solve it myself but did not succeed.
Thank you.
I've looked at the top results when typing in the Title of this question, and I hit a dead end...
I have a list of customers, and each customer gets a Job Number [Job_Ref__]. In conjunction with this, each customer gets a folder in SharePoint for all of their documents. The naming convention is Job Number - Last Name, First Name. I want to be able to click a button on my Access form that opens the customer's specific folder, but it keeps opening "My Documents" on my local disk instead.
I've tried the below code without the customer's folder details, and it opens the root of the SharePoint 'drive' with no issue...
Below is what works when I click my OPEN FOLDER button on the form:
Private Sub Command232_Click()
Dim folderName As String
Dim folderfullPath As String
folderName = Me.FilePath
folderfullPath = "C:\Users\" & Environ("Username") & "\SharePoint Site\Customers 2020\"
Call Shell("explorer.exe " & folderfullPath, vbNormalFocus)
End Sub
When I use folderName is when I hit the issue; I've tried to wildcard the folder name, but to no avail:
Private Sub Command232_Click()
Dim folderName As String
Dim folderfullPath As String
folderName = Me.FilePath
folderfullPath = "C:\Users\" & Environ("Username") & "\SharePoint Site\Customers 2020\"
Call Shell("explorer.exe " & folderfullPath & folderName & "*", vbNormalFocus)
End Sub
Any help would be GREATLY appreciated, as I've hit a pretty big brick wall.
Of note: I tried to define folderName = Job_Ref__, but I figured that was too vague, so I added a FilePath field with macros in the Access Form that builds the customer's folder name Job_Ref__ - Last Name, First Name
None of this has worked - am I doing too much with this? XD
Windows allows comma in file name but Shell() function does not like. Options:
don't use comma in file name and use Replace() function in VBA to eliminate comma from field value to match file name
use FollowHyperlink to open folder - it does accept comma
FollowHyperlink(folderfullPath & folderName)
I have a user form to browse an excel file & a text file into 2 different textboxs (Selectionfile say ABC.xlsx & relationshipfile say GHJ.txt resp.) from local folders. On clicking the proceed button, the selected file must be copied from the path to the project location used by the program with same filenames with date(ABC_27092016.xlsx & GHJ_27092016.txt resp. as backup files) and in case if the file already exists with the same filename (if user selects the same filename in the user form) then the message should show "if to continue with the existing file in project folder? or replace it with the new file selected". If user selects replace then it should replace with the new file & date. If user selects not to replace it should not copy but proceed to next step.
This is the code below which just copies but doe not do the process above to check if file exist already or
'back up selected files to project folder & rename with date
Private Sub Proceed_Click(sender As Object, e As EventArgs) Handles Proceed.Click
Dim selectionpath As String = selectionfilepath 'selectionpath is from the textbox1 in userform
Dim relationpath As String = relationshipfilepath 'relationpath is from the textbox2 in userform
Dim Timestamp As Date = Now
Dim destination1 As String = "C:\Users\UserA\Documents\Visual Studio 2015\Projects\NetSoftware\Files\Example_selectionfile_" & Format(Timestamp, "yyyy-mm-dd") & ".xlsx"
Dim destination2 As String = "C:\Users\UserA\Documents\Visual Studio 2015\Projects\NetSoftware\Files\Example_relationfile_" & Format(Timestamp, "yyyy-mm-dd") & ".txt"
If (SelectionFIleName.Text = "" Or RelationshipFileName.Text = "") Then
MessageBox.Show("Please select one of the file")
Else
FileCopy(selectionpath, destination1) 'copying the excel file to project location
FileCopy(relationpath, destination2) 'copying text file to project location
Rename(destination1, selectionpath) 'renaming the excel file since it stores as Example_selectionfile instead of the exact name of the user slected filename and also missing the date
Rename(destination2, relationpath) 'renaming the excel file since it stores as Example_relationfile instead of the exact name of the user slected filename and also missing the date
End If
End Sub
Lets say I have a list of files separated by a comma.
Dim listOfFiles As String() = filesPosted.Split(",")
And I use DirectoryInfo to grab that list of files and send it to another array.
Dim files = New DirectoryInfo(StorageRoot) _
.GetFiles("*", SearchOption.TopDirectoryOnly) _
.Where(Function(f) Not f.Attributes.HasFlag(FileAttributes.Hidden)) _
.Where(Function(f) filesPosted.Contains(f.Name)) _
.[Select](Function(f) New FilesStatus(f)).ToArray()
The problem I'm facing is, I need my condition to be more strict. I'll explain:
If my listOfFiles contains ( abc.txt, xyz.txt ) and there's a filename of aabc.txt in the directory that is being searched, it'll return both abc.txt and aabc.txt. I know this is because of this part of the clause:
.Where(Function(f) filesPosted.Contains(f.Name))
As the contains attribute is finding this other file... But I don't want it. I want the files to match exactly based on the string().
Is there a better way to do this without cycling through each file? A tighter way to make it a strict condition on "Contains" ?
Thank you for your help!
Try:
Dim listOfFiles As String() = filesPosted.Split(",").Select(function(f) f.ToLower())
' then
Dim files = New DirectoryInfo(StorageRoot) _
.GetFiles("*", SearchOption.TopDirectoryOnly) _
.Where(Function(f) Not f.Attributes.HasFlag(FileAttributes.Hidden)) _
.Where(Function(f) listOfFiles.Any(function(l) l = f.Name.ToLower())) _
.[Select](Function(f) New FilesStatus(f)).ToArray()
Sorry, poor C# to VB.Net conversion
I am open to completely changing this code. The link to the original is in the code itself. I'm sure there's an easier way to do it and the actual renaming part is NOT my own code, so I will redo it so it isn't plagiarizing. I can't use a batch file renamer to do it; I need to make it myself to stay out of trouble with legal :) No grey area!
Anyways, after a few dozen attempts on my own, I finally caved and grabbed this code online that is supposed to rename the files I specify. I edited it to fit my parameters and assigned variables/directories. When I run it, however, I always get a return of zero and the files are not being renamed. The one thing I could think of is that this directory is going to the full path name of the folder instead of the part after the last "\". But I'm not sure how to fix this either. I thought about trying to tell it to only tell it to pull, say the last 8 characters of the string, but that won't work either as these string lengths will vary anywhere from one character to 20 or so characters.
Here is my code:
Private Sub Apply_Click()
'This will initiate Module 1 to do a batch rename to find and replace all
'Module 1 will then initiate the resolving links process
Dim intResponse As Integer 'Alerts user to wait until renaming is complete
intResponse = MsgBox("Your folders are being updated. Please wait while your files are renamed and your links are resolved.")
If intResponse = vbOK Then 'Tests to see if msgbox_click can start a new process
Dim i As Integer
Dim from_str As String
Dim to_str As String
Dim dir_path As String
from_str = Old_Name_Display.Text
to_str = New_Name.Text
dir_path = New_Name.Text
If Right$(dir_path, 1) <> "\" Then dir_path = dir_path _
& "\"
Old_Name_Display = dir$(dir_path & "*.*", vbNormal)
Do While Len(Old_Name_Display) > 0
' Rename this file.
New_Name = Replace$(Old_Name_Display, from_str, to_str)
If New_Name <> Old_Name_Display Then
Name Old_Name_Display.Text As New_Name.Text
i = i + 1
End If
' Get the next file.
Old_Name_Display = dir$()
Loop
MsgBox "Renamed " & Format$(i) & " files. Resolving links now."
If intResponse = vbOK Then
MsgBox "You selected okay. Good luck coding THIS." 'Filler line to test that next step will be ready to initialize
Else: End
End If
Exit Sub
'Most of batch renaming process used from VB Helper, sponsored by Rocky Mountain Computer Consulting, Inc. Copyright 1997-2010; original code available at http://www.vb-helper.com/howto_rename_files.html
End Sub
Does anyone have another theory on why I get a 0 return/how to fix that potential above problem?
It doesn't look like the directory is getting referenced in the rename.
Change
Name Old_Name_Display.Text As New_Name.Text
to
Name Dir_Path & Old_Name_Display.Text As Dir_Path & New_Name.Text