Is there any reason why someone would set a DateTime variable equal to itself in Visual Basic like dtLocDate is in the code below?
Function ShouldBillingStart(ByVal sTheBillingType As String, _
ByRef bStartIt As Boolean, _
ByVal dtBillPeriod As DateTime) As Boolean
Dim bLocResult As Boolean
Dim dtFirstOfMonth As DateTime
Dim dtLocDate As DateTime
bLocResult = True
bStartIt = True
If bLocResult = True Then
If CInt(sTheBillingType) = gTheMasterPriceList.PricingType.PRICING_TYPE_DISCOUNTED Then
dtLocDate = dtLocDate
dtFirstOfMonth = CDate(Year(dtLocDate) & "/" & Month(dtLocDate) & "/1")
'add a month
dtFirstOfMonth = DateAdd(DateInterval.Month, 1, dtFirstOfMonth)
If Now < dtFirstOfMonth Then
bStartIt = False
End If
End If
End If
ShouldBillingStart = bLocResult
End Function
In short, no. This is just referencing itself. The Dim statement instantiates the Date object. Self referencing it wouldn't create the object though, nor set a default value.
This appears to serve no purpose.
Yeah, no reason at all. For example:
Dim This as String
This = "that"
This = This
Waste of time & resources...
Related
I'm trying to inspect an object when a new instance is created. The instance is created with a function DaySchedule.Create(). I can do that because I set the attribute VB_PredeclaredId = True. Here's the code of the function:
Public Function Create( _
ByVal Name As String, _
ByVal Cycle As Long, _
ByVal Prio As Long, _
ByVal startDate As Date, _
ByVal WeekDays As String) As WeekSchedule
Dim WeekDays_Arr() As String
Dim Days As Variant
me_Monday = False
me_Tuesday = False
me_Wednesday = False
me_Thursday = False
me_Friday = False
me_Saturday = False
me_Sunday = False
WeekDays_Arr = Split(WeekDays, ";")
For Each Days In WeekDays_Arr
Select Case Days
Case "Mo": me_Monday = True
Case "Tu": me_Tuesday = True
Case "We": me_Wednesday = True
Case "Th": me_Thursday = True
Case "Fr": me_Friday = True
Case "Sa": me_Saturday = True
Case "Su": me_Sunday = True
End Select
Next Days
me_ScheduleType = "weekly"
me_Name = Name
me_Cycle = Cycle
me_Prio = Prio
me_StartDate = startDate
Set Create = Me
End Function
The problem is whenever I open the locals window and try to expand Me Excel is loading infinitly. Sometimes it works after 20 seconds or so, but then every line take's 20 seconds. My CPU load is only 15% and I dont have other functions in the Excel workbook that might be calculated. Yesterday I have done exactly the same thing and it expanded instantly. Does anyone have a similar issue or the solution?
I found the solution. The problem lied in a property named Schedule_NextBackup. The Get-property didn't set a property but calculated something. I changed it to a function and it doesn't lag anymore.
I am trying to write a simple code that filters out data based on some condition.
My code is below :
Public Function fGetUniqInitiative(Optional ByVal uniqInitiative As Variant, Optional ByVal filter1 As Variant, Optional ByVal filter2 As Variant, Optional ByVal filter3 As Variant, Optional ByVal vartempData As Variant) As Variant()
Dim lngcounterinitiatve As Long
Dim lngVarData As Long
Dim lngfilter1 As Long
Dim lngfilter2 As Long
Dim lngfilter3 As Long
Dim boolfilter1 As Boolean
Dim boolfilter2 As Boolean
Dim boolfilter3 As Boolean
Dim varUniqueList() As Variant
Dim lnguniqueinitcount As Long
lnguniqueinitcount = 0
For lngcounterinitiative = LBound(uniqInitiative) To UBound(uniqInitiative)
boolfilter1 = False
boolfilter2 = False
boolfilter3 = False
For lngVarData = LBound(vartempData) To UBound(vartempData)
If uniqInitiative(lngcounterinitiative) = vartempData(lngVarData, 2) Then
For lngfilter1 = LBound(filter1) To UBound(filter1)
If vartempData(lngVarData, 9) = filter1(lngfilter1) Then
boolfilter1 = True
Exit For
End If
Next lngfilter1
For lngfilter2 = LBound(filter2) To UBound(filter2)
If vartempData(lngVarData, 10) = filter2(lngfilter2) Then
boolfilter2 = True
Exit For
End If
Next lngfilter2
For lngfilter3 = LBound(filter3) To UBound(filter3)
If vartempData(lngVarData, 11) = filter3(lngfilter3) Then
boolfilter3 = True
Exit For
End If
Next lngfilter3
If boolfilter1 = True Or boolfilter2 = True Or boolfilter3 = True Then
Exit For
Else
lnguniqueinitcount = lnguniqueinitcount + 1
ReDim varUniqueList(1 To lnguniqueinitcount)
End If
End If
Next lngVarData
Next lngcounterinitiatve
fGetUniqInitiative = varUniqueList
End Function
However, when i try to compile the code it gives the error "Invalid Next Control Variable reference". I have googled it quite a bit and all the solutions say that i must be missing closing the loop which i don't think is the case in my code. Anyone could point what am i missing?
lngcounterinitiative is spelled wrong in "Next lngcounterinitiatve".Try changing that.
I am attempting to do a VLOOKUP on a different worksheet based on given parameters in the function. I've played around with it for several hours and can not figure out why it is not working. I cut down the code as much as I could to test, but am unable to effectively find a solution. I think it might be an issue of how I am calling the range from the other worksheet for the VLOOKUP. Code is below. Please advice. If I'm unclear about what I'm asking just ask and I will provide feedback. Thank you
Function GraphDataA(cR As String, time As String, aClient As String, tps As String, dat As String)
Dim client As Boolean
Dim day As Boolean
Dim tot As Boolean
Dim dayTotData As Range
Dim dayTotDatas As Worksheet
Set dayTotDatas = ActiveWorkbook.Sheets("DayTot")
Set dayTotData = dayTotDatas.Range("A3:AI168")
client = False
day = False
tot = False
If date = "" Then
GraphDataA = ""
End If
If aClient = "" Then
GraphDataA = ""
End If
If cR = "Client" Then
client = True
End If
If time = "Day" Then
day = True
End If
If tps = "Total" Then
tot = True
End If
If client = True Then
If day = True Then
If tot = True Then
GraphDataA = WorksheetFunction.VLookup(aClient, dayTotData, WorksheetFunction.Match(dat, dayDate, 0) + 8, _
False)
End If
End If
End If
End Function
VLOOKUP() will throw an error if nothing matches. So you need to add error catching code to your function.
You need to modify the function as
Function MyFunction() as Something
On Error Goto ErrorHandler
' Your existing code goes here
Exit Function
ErrorHandler:
MyFunction = -1 ' Or something which indicates that the value isn't found
End Function
You don't appear to be returning any value from your function. Try adding As Variant to the end of the first line like so:
Function GraphDataA(cR As String, time As String, aClient As String, tps As String, dat As String) As Variant
I have a little VBA script with some functions that I would like to convert to a single VBS file.
Here is an example of what I got:
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Function ReadIniFileString(ByVal Sect As String, ByVal Keyname As String) As String
Dim Worked As Long
Dim RetStr As String * 128
Dim StrSize As Long
Dim iNoOfCharInIni As Integer
Dim sIniString, sProfileString As String
iNoOfCharInIni = 0
sIniString = ""
If Sect = "" Or Keyname = "" Then
MsgBox "Erreur lors de la lecture des paramètres dans " & IniFileName, vbExclamation, "INI"
Access.Application.Quit
Else
sProfileString = ""
RetStr = Space(128)
StrSize = Len(RetStr)
Worked = GetPrivateProfileString(Sect, Keyname, "", RetStr, StrSize, IniFileName)
If Worked Then
iNoOfCharInIni = Worked
sIniString = Left$(RetStr, Worked)
End If
End If
ReadIniFileString = sIniString
End Function
And then, I need to use this function to put some values in strings. VBS doesn't seem to like any of my var declaration ((Dim) MyVar As MyType).
If I'm able to adapt that code to VBS, I should be able to do the rest of my functions too. How can I adapt/convert this to VBS? Thank you.
It's a pitty i didn't see this earlier, anyway, for future reference here is a pure vbscript solution to read a value from an ini file. If anyone needs explanation on the used regular expression just leave a comment.
'this is the contents of test.ini'
' [Brussels]
' Address = "Postbox 3245_58348 Brussels"
' [Copenhagen]
' Address = "Postbox 2455_5478347 Copenhagen"
' [Paris]
' Address = "Postbox 8546_5412557 Paris"
section = "Brussels"
key = "Address"
const ForReading = 1
set fso = CreateObject("Scripting.FileSystemObject")
set file = fso.OpenTextFile("test.ini", ForReading)
'returns "Postbox 3245_58348 Brussels"'
wscript.echo get_key_of_ini(file.readall, section, key)
function get_key_of_ini(readFile, section, key)
set regEx = New RegExp
with regEx
.Pattern = "(\[" & section & "\]\r\n)([^\[]+)"
.IgnoreCase = True
.Global = True
end With
set matches = regEx.execute(readFile)
for x = 0 to matches.count-1
set match = matches(x)
For i = 1 To match.subMatches.count-1
subMatches = match.SubMatches(i)
if trim(split(match.SubMatches(i),"=")(0)) = key then
get_key_of_ini = trim(split(match.SubMatches(i),"=")(1))
end if
Next
next
end function
Since you have an MDB that does what you want, run the VBS script to open this mdb and set the AutoExec Macro to run the functions that compact these Databases and then self close the MDB. This is a bit hacky but may prove to be the least troublesome.
I am not very well-versed in Reflection, but I have been working on this bit of code for a few days trying to obtain the values of class properties. I am using an API to find the values inside of cron jobs managed by the program VisualCron.
I'll explain the structure a bit. Each cron job has several tasks inside of it which have their own settings. The settings are stored in properties inside the TaskClass class that are declared like so:
Public Property <propertyname> As <classname>
Each property is tied to its own class, so for instance there is an Execute property inside TaskClass which is declared like this:
Public Property Execute As TaskExecuteClass
Inside TaskExecuteClass are the properties that hold the values I need. With the below block of code I have been able to retrieve the property values of all types EXCEPT strings. Coincidentally, the string values are the only values I need to get.
I know there must be something wrong with what I've written causing this because I can't find anyone with a similar issue after lots and lots of searching. Can anyone help me please?
Dim strAdd As String = ""
For Each t As VisualCronAPI.Server In vcClient.Servers.GetAll()
For Each f As VisualCron.JobClass In t.Jobs.GetAll
For Each s As VisualCron.TaskClass In f.Tasks
Dim propVal As Object
Dim propInfo As PropertyInfo() = s.GetType().GetProperties()
For i As Integer = 0 To propInfo.Length - 1
With propInfo(i)
If s.TaskType.ToString = propInfo(i).Name.ToString Then
Dim asm As Assembly = Assembly.Load("VisualCron")
Dim typeName As String = String.Format("VisualCron.{0}", propInfo(i).PropertyType.Name)
Dim tp As Type = asm.GetType(typeName)
Dim construct As ConstructorInfo = tp.GetConstructor(Type.EmptyTypes)
Dim classInst As Object = construct.Invoke(Nothing)
Dim classProps As PropertyInfo() = classInst.GetType().GetProperties()
For h As Integer = 0 To classProps.Length - 1
With classProps(h)
If .GetIndexParameters().Length = 0 Then
propVal = .GetValue(classInst, Nothing)
If Not propVal Is Nothing Then
strAdd = f.Name & " - " & s.Name & " - " & .Name & " - " & propVal.ToString
End If
End If
If strAdd <> "" Then
ListBox1.Items.Add(strAdd)
End If
End With
Next
End If
End With
Next
Next s
Next f
Next t
I solved my own problem, albeit in a crappy way. This is probably incredibly inefficient, but speed isn't a necessity in my particular case. Here is the code that works:
Dim strAdd As String = ""
For Each t As VisualCronAPI.Server In vcClient.Servers.GetAll()
For Each f As VisualCron.JobClass In t.Jobs.GetAll
For Each s As VisualCron.TaskClass In f.Tasks
Dim propVal As Object
Dim propInfo As PropertyInfo() = s.GetType().GetProperties()
For i As Integer = 0 To propInfo.Length - 1
With propInfo(i)
If s.TaskType.ToString = propInfo(i).Name.ToString Then
Dim asm As Assembly = Assembly.Load("VisualCron")
Dim typeName As String = String.Format("VisualCron.{0}", propInfo(i).PropertyType.Name)
Dim tp As Type = asm.GetType(typeName)
Dim construct As ConstructorInfo = tp.GetConstructor(Type.EmptyTypes)
Dim classInst As Object = construct.Invoke(Nothing)
Dim classProps As PropertyInfo() = classInst.GetType().GetProperties()
For h As Integer = 0 To classProps.Length - 1
With classProps(h)
If .GetIndexParameters().Length = 0 Then
propVal = .GetValue(CallByName(s, propInfo(i).Name.ToString, [Get]), Nothing)
If Not propVal Is Nothing Then
If propVal.ToString.Contains("\\server\") Or propVal.ToString.Contains("\\SERVER\") Then
strAdd = f.Name & " - " & s.Name & " - " & .Name & " - " & propVal.ToString
ListBox1.Items.Add(strAdd)
End If
End If
End If
End With
Next
End If
End With
Next
Next s
Next f
Next t
The piece of code that made the difference was the
classProps(h).GetValue(CallByName(s, propInfo(i).Name.ToString, [Get]), Nothing)
line.
If there are any suggestions for improving this code - I'm assuming that I've still got a lot of mistakes in here - then please comment for the future viewers of this answer and so I can adjust my code and learn more about how all of this works.