Function to mask everything but last four digits of SSN - vb.net

I have this function for ID. I need new function to mask first 5 characters something like "xxx-xx-1234"
public shared function ID (ByVal id As string) As string
if string.IsnullorEmpty(id) then
return string.empty
elseif isnumeric(id) then
return string.Format("{0:000-00-0000}", CDbl(id))
elseif id.length=9 then
return id.Substring(0,3) & "-" & _
id.Substring(3,2) & "-" & _
id.Substring(5,4)
else
return id
End if
End function

Related

Integrate Replace in a Private Sub

How to integrate Replace in this Private Sub?
I need to replace all words "NONE" with "":
Private Sub UpdateSKU()
Dim str As String
str = Me.Combo216.Column(1) & Space(1) & Me.Combo224.Column(1) & Space(1)
Me.Text423.Value = str
End Sub
I have tried
Private Function NONE(a As String)
If InStr(a, "NONE") > 0 Then
MsgBox "Original: " & a & vbCrLf & "Adjusted: " & Replace(a, "NONE", "")
End If
End Function
But I can't get it to work.
A function should return a value...
Your function does not declare a return type, nor does it ever assign a return value.
Try this instead:
Private Function NONE(a As String) As String
NONE = Replace(a, "NONE", "")
End Function
Try this:
Private Sub UpdateSKU()
Dim Text As String
Text = Me.Combo216.Column(1) & Space(1) & Me.Combo224.Column(1) & Space(1)
Me.Text423.Value = Replace(Text, "NONE", "")
End Sub
Also, don't use common function names (Str) for variables, and do rename your controls to something meaningful.

Name depends on the number of characters

How to write a conditional statement acting as follows:
If "% name%" has 1 character, name: 00 "% name%"
If "% name%" has 2, name: 0 "% name%"
If "% name%" has 3 , name: "% name%"
action.SetDynamicParameter("FileName", ((((((("%version%" + "_") _
+ String.Join(", ", array2)) _
+ "_") _
+ "%name%") _
+ ".jpg"))
I will be grateful for your help.
It looks to me like your just trying to pad a number as a string with leading zeros to a length of 3. Is that correct? If so, try this:
Private Function FormatMyName(ByVal Name As String) As String
Return Name.PadLeft(3, "0")
End Function
If created it as a function so it's easier for you to add the additional formatting you need (e.g. adding a .jpg extension)
Check the return of the Function for Nothing or check the length of the string before passing it to the Function.
Private Function GetPaddedName(OriginalName As String) As String
Dim PaddedString As String = ""
Select Case OriginalName.Length
Case 1
PaddedString = "00" & OriginalName & ".jpg"
Case 2
PaddedString = "0" & OriginalName & ".jpg"
Case 3
PaddedString = OriginalName & ".jpg"
Case Else
PaddedString = Nothing
End Select
Return PaddedString
End Function

System.IndexOutOfRangeException VB GradeBook

So I get this error when trying to run my code "System.IndexOutOfRangeException: 'Index was outside the bounds of the array.'" I am not exactly sure what the issue is. The user should be able to enter 3 assignment grades and then see the averages
I marked the line where I get the error with 'THIS IS THE ERROR'
Public Class GradeBook
Dim grade(9, 2) As Integer 'Store 10 student grades on 3 tests'
Dim studentCount As Integer = 0 'Number of students entered'
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
GradeListBox.Items.Add(vbTab & vbTab & "Test 1" & vbTab & "Test 2" & vbTab & "Test 3" & vbTab & "Average")
End Sub
Private Sub SubmitButton_Click(sender As Object, e As EventArgs) Handles SubmitButton.Click
grade(studentCount, 0) = Convert.ToInt32(Assignment1TextBox.Text)
grade(studentCount, 1) = Convert.ToInt32(Assignment2TextBox.Text)
grade(studentCount, 2) = Convert.ToInt32(Assignment3TextBox.Text)
Dim output As String = "Student " & studentCount & vbTab
For column = 0 To grade.GetUpperBound(1)
If LetterRadioButton.Checked = True Then
output &= vbTab & LetterGrade(grade(studentCount, column))
Else
output &= vbTab & grade(studentCount, column)
End If
Next
output &= vbTab & CalculateStudentAverage(studentCount)
GradeListBox.Items.Add(output)
studentCount += 1
AverageLabel.Text = CalculateClassAverage()
displayBarChart()
End Sub
Function LetterGrade(ByVal grade As Double) As String
Dim output As String = ""
Select Case grade
Case Is >= 90
output = "A"
Case Is >= 80
output = "B"
Case Is >= 70
output = "C"
Case Is >= 60
output = "D"
Case Is >= 50
output = "E"
End Select
Return output
End Function
Function CalculateStudentAverage(ByVal row As Integer) As String
Dim gradeTotal As Integer = 0
For column = 0 To grade.GetUpperBound(1)
gradeTotal += grade(row, column) 'THIS IS THE ERROR'
Next
Dim studentAverage As String = String.Empty
If LetterRadioButton.Checked = True Then
studentAverage = LetterGrade(gradeTotal / (grade.GetUpperBound(1) + 1))
Else
studentAverage = String.Format("{0:F}", (gradeTotal / grade.GetUpperBound(1) + 1))
End If
Return studentAverage
End Function
Function CalculateClassAverage() As String
Dim classTotal As Integer = 0
For row = 0 To studentCount - 1
For column = 0 To grade.GetUpperBound(1)
classTotal += grade(row, column)
Next
Next
Dim classAverage As String = String.Empty
If LetterRadioButton.Checked = True Then
classAverage = LetterGrade(classTotal / (studentCount * (grade.GetUpperBound(1) + 1)))
Else
classAverage = String.Format("{0:F}", (classTotal / (studentCount * (grade.GetUpperBound(1) + 1))))
End If
Return classAverage
End Function
Sub displayBarChart()
GradeListBox.Items.Clear()
GradeListBox.Items.Add(vbTab & vbTab & "Test 1" & vbTab & "Test 2" & vbTab & "Test 3" & vbTab & "Average")
For row = 0 To studentCount - 1
Dim output As String = "Student " & row & vbTab
For column = 0 To grade.GetUpperBound(1)
If LetterRadioButton.Checked = True Then
output &= vbTab & LetterGrade(grade(row, column))
Else
output &= vbTab & (grade(row, column))
End If
Next
output &= vbTab & CalculateStudentAverage(studentCount)
GradeListBox.Items.Add(output)
studentCount += 1
AverageLabel.Text = CalculateClassAverage()
displayBarChart()
Assignment1TextBox.Clear()
Assignment2TextBox.Clear()
Assignment3TextBox.Clear()
If studentCount = grade.GetUpperBound(0) + 1 Then
InputGradeGroupBox.Enabled = False
End If
Next
End Sub
End Class
To be honest, I suspect you're going about it in a way not suited to OOP. Using arrays for multiple peices of data is prone to error and harder to maintain later.
Lets have a think about how you want to represent your data. You have a bunch of students. In a more complete example each student would have a name, personal details such as address, a list of the courses they're taking and for each course, a list of assignments and scores for each assignment which can also be represented as a grade.
So in essence you have a class called Student and the various bits of information are properties of that student.
Finally you have a list of these students
In your code, you simply have a student number and three assignment scores.
Your basic student class should have the properties of Number, Test1Score, Test2Score and Test3Score. You would also want to be able to get the grade from each score, the average of all the scores and the average of all the grades.
The code below defines the Student class with that information in mind
Friend Class Student
Public Property Number As Integer
Public Property Test1Score As Integer
Public Property Test2Score As Integer
Public Property Test3Score As Integer
Public Function Test1Grade() As String
Return LetterGrade(Test1Score)
End Function
Public Function Test2Grade() As String
Return LetterGrade(Test2Score)
End Function
Public Function Test3Grade() As String
Return LetterGrade(Test3Score)
End Function
Friend Shared Function LetterGrade(ByVal grade As Double) As String
Dim output As String = ""
Select Case grade
Case Is >= 90
output = "A"
Case Is >= 80
output = "B"
Case Is >= 70
output = "C"
Case Is >= 60
output = "D"
Case Is >= 50
output = "E"
Case Else
output = "F"
End Select
Return output
End Function
Friend Function AverageScore() As Double
Return (Test1Score + Test2Score + Test3Score) / 3
End Function
Friend Function AverageGrade() As String
Dim avgscore As Double = AverageScore()
Return LetterGrade(avgscore)
End Function
End Class
The function LetterGrade is Shared so that it can be used in your main form to calculate the average grade for the entire class.
OK Next think about how you want your program to work. You'll need a list of students, so at the beginning of your form class , you'll need this..
Public Class Form1
Private Students As New List(Of Student)
This way, instead of trying to keep track of your variable studentCount you can just use the .Count property of the List e.g Students.Count. You wont need to any adding to it as the Students list keeps track of it automatically.
Next, you'll want the function that calculates the average score/grade of the class..
Function CalculateClassAverage() As String
Dim classTotal As Integer = 0
For Each tmpStudent As Student In Students
With tmpStudent
classTotal += .Test1Score + .Test2Score + .Test3Score
End With
Next
Dim classAverage As String = String.Empty
If LetterRadioButton.Checked = True Then
classAverage = Student.LetterGrade((classTotal / Students.Count) / 3)
Else
classAverage = String.Format("{0:F}", (classTotal / (Students.Count)) / 3)
End If
Return classAverage
End Function
As you can see, there are a number of differences here because of the way your data is stored, but you should be able to follow it. One difference is the With statement, this allows you to save on typing. inside the With.. End With block, instead of typing tmpstudent.Test1Score etc, you can just type .Test1Score
The other thing of note is this line ..
classAverage = Student.LetterGrade( ... etc
You may think that there has been no declaration of a variable called Student. There IS a class, but not a variable. What this is actually doing is calling the LetterGrade function that is shared in the Student class definition.. Have a look at shared functions.
Next is the code to display the information in the ListBox. I haven't changed the name even though it is misleading btw.
Sub displayBarChart()
GradeListBox.Items.Clear()
GradeListBox.Items.Add(vbTab & vbTab & "Test 1" & vbTab & "Test 2" & vbTab & "Test 3" & vbTab & "Average")
For Each tmpstudent As Student In Students
Dim output As String = "Student " & tmpstudent.Number & vbTab
With tmpstudent
If LetterRadioButton.Checked = True Then
output &= .Test1Grade & vbTab & .Test2Grade & vbTab & .Test3Grade & vbTab & .AverageGrade
Else
output &= .Test1Score & vbTab & .Test2Score & vbTab & .Test3Score & vbTab & .AverageScore
End If
End With
GradeListBox.Items.Add(output)
AverageLabel.Text = CalculateClassAverage()
Next
If Students.Count = 10 Then
InputGradeGroupBox.Enabled = False
End If
End Sub
More use of the With..End With statements again, but the rest should be straighforward to follow.
A little extra bit of code.. When you click on the LetterRadioButton, the data in the listBox and ClassAveragelabel are refreshed with the appropriate letters/grades
Private Sub LetterRadioButton_CheckedChanged(sender As Object, e As EventArgs) Handles LetterRadioButton.CheckedChanged
AverageLabel.Text = CalculateClassAverage()
displayBarChart()
End Sub
Finally, to bring it all together, you have the code for the button click..
Private Sub SubmitButton_Click(sender As Object, e As EventArgs) Handles SubmitButton.Click
Dim tmpStudent As New Student With {.Number = Students.Count + 1,
.Test1Score = Convert.ToDouble(Assignment1TextBox.Text),
.Test2Score = Convert.ToDouble(Assignment2TextBox.Text),
.Test3Score = Convert.ToDouble(Assignment3TextBox.Text)}
Dim output As String = "Student " & tmpStudent.Number & vbTab
With tmpStudent
If LetterRadioButton.Checked = True Then
output &= vbTab & .Test1Grade & vbTab & .Test2Grade & vbTab & .Test3Grade
Else
output &= vbTab & .Test1Score & vbTab & .Test2Score & vbTab & .Test3Score
End If
End With
Students.Add(tmpStudent)
If LetterRadioButton.Checked Then
output &= vbTab & tmpStudent.AverageGrade
Else
output &= vbTab & tmpStudent.AverageScore
End If
GradeListBox.Items.Add(output)
AverageLabel.Text = CalculateClassAverage()
displayBarChart()
Assignment1TextBox.Clear()
Assignment2TextBox.Clear()
Assignment3TextBox.Clear()
End Sub
Hopefully in addition to my comment to your question, this provides a slightly better insight of OOP.

Conditional String Separators in SSRS using VB.NET

I have a function in SSRS using VB.NET as follows:
Public Function GenerateCSV(byval str as string, byval str1 as string, byval str2 as string, byval GrpName as string)
IF GroupName <> GrpName THEN
GroupName = GrpName
CSVString = ""
END IF
IF str = ""
CSVString = ""
ELSE
CSVString = CSVString & str & ", " & str1 & ", " & str2 & ", "
END IF
return CSVString
End function
This works great is str, str1 and str2 have a value and only one value. But I want to make it so if the value isn't there or there is only one value there is no comma and if there are multiple commas there is a comma. Is there an easy way to do this?
Thanks!
Create array from your non-empty arguments.
Use String.Join method to concatenate array elements.
Example:
String.Join("," values)
http://msdn.microsoft.com/en-us/library/system.string.join

How can I generate GUIDs in Excel?

I have an excel file with one order on each row, and I want each order to have a unique identifier, so there will be a Unique ID column. Every time I fill a row, I want Excel to automatically populate the Unique ID column for me. I did some research and was pointed in the direction of GUIDs. I found the following code:
Function GenGuid() As String
Dim TypeLib As Object
Dim Guid As String
Set TypeLib = CreateObject("Scriptlet.TypeLib")
Guid = TypeLib.Guid
' format is {24DD18D4-C902-497F-A64B-28B2FA741661}
Guid = Replace(Guid, "{", "")
Guid = Replace(Guid, "}", "")
Guid = Replace(Guid, "-", "")
GenGuid = Guid
End Function
but I am not sure how I can implement it. Any help would be greatly appreciated. Thank you in advance.
The following Excel expression evaluates to a V4 GUID:
=CONCATENATE(DEC2HEX(RANDBETWEEN(0,4294967295),8),"-",DEC2HEX(RANDBETWEEN(0,65535),4),"-",DEC2HEX(RANDBETWEEN(16384,20479),4),"-",DEC2HEX(RANDBETWEEN(32768,49151),4),"-",DEC2HEX(RANDBETWEEN(0,65535),4),DEC2HEX(RANDBETWEEN(0,4294967295),8))
-or (depending on locale setting/decimal and list separators)-
=CONCATENATE(DEC2HEX(RANDBETWEEN(0;4294967295);8);"-";DEC2HEX(RANDBETWEEN(0;65535);4);"-";DEC2HEX(RANDBETWEEN(16384;20479);4);"-";DEC2HEX(RANDBETWEEN(32768;49151);4);"-";DEC2HEX(RANDBETWEEN(0;65535);4);DEC2HEX(RANDBETWEEN(0;4294967295);8))
Note that the first character of the third group is always 4 to signify a V4 (pseudo-random number generated) GUID/UUID per RFC 4122 section 4.4.
Also note that the first character of the fourth group is always between 8 and B per the same RFC.
Standard disclaimer: the resulting GUIDs/UUIDs are not cryptographically strong.
Edit: remove invisible characters
I used the following function in v.2013 excel vba to create a GUID and is working well..
Public Function GetGUID() As String
GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function
I know this question is answered, but I think the code in question should look something like what's on this page: http://snipplr.com/view/37940/
Haven't tested, but this code seems to tap into the Windows API to get its GUID's - I would try putting that in a public module and typing =GetGUId() in an Excel cell to see what I'd get. If it works in VB6 you have a great deal of a good chance it works in VBA as well:
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long
Public Function GetGUID() As String
'(c) 2000 Gus Molina
Dim udtGUID As GUID
If (CoCreateGuid(udtGUID) = 0) Then
GetGUID = _
String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _
String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _
String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _
IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _
IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _
IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _
IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _
IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _
IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _
IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _
IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7))
End If
End Function
Thanks Gus Molina!
If this code works (which I don't doubt), I think you'd get a new set of GUID's whenever the function gets evaluated, which means everytime the sheet gets calculated - when you're saving the workbook, for example. Make sure to copy-pastespecial-values if you need the GUID's for later use... which is somewhat likely.
A VBA approach based on generating random numbers using the Rnd() function, and not on external API calls or Scriptlet.TypeLib:
Public Function CreateGUID() As String
Do While Len(CreateGUID) < 32
If Len(CreateGUID) = 16 Then
'17th character holds version information
CreateGUID = CreateGUID & Hex$(8 + CInt(Rnd * 3))
End If
CreateGUID = CreateGUID & Hex$(CInt(Rnd * 15))
Loop
CreateGUID = "{" & Mid(CreateGUID, 1, 8) & "-" & Mid(CreateGUID, 9, 4) & "-" & Mid(CreateGUID, 13, 4) & "-" & Mid(CreateGUID, 17, 4) & "-" & Mid(CreateGUID, 21, 12) & "}"
End Function
This essentially is a VBA implementation of NekojiruSou's answer (it also generates a v4 GUID), and carries the same limitations, but will work in VBA and might be easier to implement.
Note that you can omit the last line to not return the dashes and curly braces in the result.
I found pretty solution here:http://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=751237&msg=8634441
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function CoCreateGuid Lib "ole32" (pguid As GUID) As Long
Private Declare Function StringFromGUID2 Lib "ole32" ( _
rguid As GUID, ByVal lpsz As Long, ByVal cchMax As Long) As Long
Public Function CreateGUID() As String
Dim NewGUID As GUID
CoCreateGuid NewGUID
CreateGUID = Space$(38)
StringFromGUID2 NewGUID, StrPtr(CreateGUID), 39
End Function
This is based on a javascript implementation.
Private Function getGUID() As String
Call Randomize 'Ensure random GUID generated
getGUID = "xxxxxxxx-xxxx-4xxx-yxxx-xxxxxxxxxxxx"
getGUID = Replace(getGUID, "y", Hex(Rnd() And &H3 Or &H8))
Dim i As Long: For i = 1 To 30
getGUID = Replace(getGUID, "x", Hex$(Int(Rnd() * 16)), 1, 1)
Next
End Function
Same same for german Excel version:
=VERKETTEN(DEZINHEX(ZUFALLSBEREICH(0;4294967295);8);"-";DEZINHEX(ZUFALLSBEREICH(0;65535);4);"-";DEZINHEX(ZUFALLSBEREICH(16384;20479);4);"-";DEZINHEX(ZUFALLSBEREICH(32768;49151);4);"-";DEZINHEX(ZUFALLSBEREICH(0;65535);4);DEZINHEX(ZUFALLSBEREICH(0;4294967295);8))
Since windows update taken out "Scriptlet.TypeLib", try the following:
Declare Function CoCreateGuid Lib "ole32" (ByRef GUID As Byte) As Long
Public Function GenerateGUID() As String
Dim ID(0 To 15) As Byte
Dim N As Long
Dim GUID As String
Dim Res As Long
Res = CoCreateGuid(ID(0))
For N = 0 To 15
GUID = GUID & IIf(ID(N) < 16, "0", "") & Hex$(ID(N))
If Len(GUID) = 8 Or Len(GUID) = 13 Or Len(GUID) = 18 Or Len(GUID) = 23 Then
GUID = GUID & "-"
End If
Next N
GenerateGUID = GUID
End Function
Alternatively,
if you are connecting to SQL Server 2008 or higher, try to use the SQL NEWID() function instead.
I created a VBA function that works both on mac and windows:
https://github.com/Martin-Carlsson/Business-Intelligence-Goodies/blob/master/Excel/GenerateGiud/GenerateGiud.bas
'Generates a guid, works on both mac and windows
Function Guid() As String
Guid = RandomHex(3) + "-" + _
RandomHex(2) + "-" + _
RandomHex(2) + "-" + _
RandomHex(2) + "-" + _
RandomHex(6)
End Function
'From: https://www.mrexcel.com/forum/excel-questions/301472-need-help-generate-hexadecimal-codes-randomly.html#post1479527
Private Function RandomHex(lngCharLength As Long)
Dim i As Long
Randomize
For i = 1 To lngCharLength
RandomHex = RandomHex & Right$("0" & Hex(Rnd() * 256), 2)
Next
End Function
I recently ran into problems using CreateObject("Scriptlet.TypeLib") in some vba code.
So based on NekojiruSou excel functions wrote the following which should work without any specific excel functions. This can be used to develop a user defined function in excel.
Public Function Get_NewGUID() As String
'Returns GUID as string 36 characters long
Randomize
Dim r1a As Long
Dim r1b As Long
Dim r2 As Long
Dim r3 As Long
Dim r4 As Long
Dim r5a As Long
Dim r5b As Long
Dim r5c As Long
'randomValue = CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound
r1a = RandomBetween(0, 65535)
r1b = RandomBetween(0, 65535)
r2 = RandomBetween(0, 65535)
r3 = RandomBetween(16384, 20479)
r4 = RandomBetween(32768, 49151)
r5a = RandomBetween(0, 65535)
r5b = RandomBetween(0, 65535)
r5c = RandomBetween(0, 65535)
Get_NewGUID = (PadHex(r1a, 4) & PadHex(r1b, 4) & "-" & PadHex(r2, 4) & "-" & PadHex(r3, 4) & "-" & PadHex(r4, 4) & "-" & PadHex(r5a, 4) & PadHex(r5b, 4) & PadHex(r5c, 4))
End Function
Public Function Floor(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
'From: http://www.tek-tips.com/faqs.cfm?fid=5031
' X is the value you want to round
' Factor is the multiple to which you want to round
Floor = Int(X / Factor) * Factor
End Function
Public Function RandomBetween(ByVal StartRange As Long, ByVal EndRange As Long) As Long
'Based on https://msdn.microsoft.com/en-us/library/f7s023d2(v=vs.90).aspx
' randomValue = CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound
RandomBetween = CLng(Floor((EndRange - StartRange + 1) * Rnd())) + StartRange
End Function
Public Function PadLeft(text As Variant, totalLength As Integer, padCharacter As String) As String
'Based on https://stackoverflow.com/questions/12060347/any-method-equivalent-to-padleft-padright
' with a little more checking of inputs
Dim s As String
Dim inputLength As Integer
s = CStr(text)
inputLength = Len(s)
If padCharacter = "" Then
padCharacter = " "
ElseIf Len(padCharacter) > 1 Then
padCharacter = Left(padCharacter, 1)
End If
If inputLength < totalLength Then
PadLeft = String(totalLength - inputLength, padCharacter) & s
Else
PadLeft = s
End If
End Function
Public Function PadHex(number As Long, length As Integer) As String
PadHex = PadLeft(Hex(number), 4, "0")
End Function
For generating random guids using just the Rnd() function, not using any libraries or APIs, the simplest I can think of is this:
' UUID Version 4 (random)
Function GetUUID4()
Dim guid As String
Dim i As Integer
Dim r As Integer
guid = ""
Randomize
For i = 0 To 31
' random digit 0..15
r = Rnd() * 15
' add dash separators
If (i = 8) Or (i = 12) Or (i = 16) Or (i = 20) Then guid = guid & "-"
' uuid4 version info in 12th and 16th digits
If (i = 12) Then r = 4
If (i = 16) Then r = (r And 3 Or 8)
' add as hex digit
guid = guid & Hex(r)
Next i
GetUUID4 = guid
End Function
If you are inserting records into a database you can use this way to make a GUID.
It is probably the most simplest and easiest way to implement as you don't need a complex VBA function as you use the built in SQL function.
The statement uses NewID(),
The syntax is as follows,
INSERT INTO table_name (ID,Column1,Column2,Column3)
VALUES (NewID(),value1,value2,value3)
In VBA syntax it is as follows,
strSql = "INSERT INTO table_name " _
& "(ID,Column1,Column2,Column3) " _
& "VALUES (NewID(),value1,value2,value3)"
And if you need to concatenate values, just treat it as a string and concatenate as you would normally for a SQL statement,
strSql = "INSERT INTO table_name " _
& "(ID,Column1,Column2,Column3) " _
& "VALUES (" & "NewID()" & "," & "value1" & "," & "value2" & "," & "value3" & ")"
Function funGetGuid() As String
Const URL As String = "http://www.guidgen.com/"
Const strMask As String = "value="
Dim l As Long
Dim txt As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
txt = .responseText
End With
Do
l = InStr(l + 1, txt, strMask)
If l = 0 Then Exit Do
funGetGuid = Mid$(txt, l + Len(strMask) + 1, 36)
Loop
End Function