Excel VBA

• Get current user name
• Add Worksheet if it does not exist
• High Precision Timer using Windows API
• Get user desktop and make a folder
• Delete a worksheet
• Detect OS Type

Get current user name

For a computer that is not joined to a domain (Computer Username)

Sub Get_Username()
'Get the environment username
Dim UserName As String
UserName = Environ$("UserName")
MsgBox "Hello " & UserName
End Sub

For a computer that is joined to a domain (Domain Display Name)

Sub Get_DomainDisplayName()
'Get the environment username
Dim UserName As String, DisplayName As String
UserName = Environ$("UserName")
'Get the displayname
Dim objAllNames As Object
On Error Resume Next
Set objAllNames = GetObject("Winmgmts:").instancesof("win32_networkloginprofile")
For Each objIndName In objAllNames
If objIndName = UserName Then
DisplayName = objIndName.FullName
End If
Next
MsgBox "Hello " & DisplayName
End Sub

Add Worksheet if it does not exist

Add a worksheet titled "Data" if it doesn't exist and ignore adding if it already exists

Sub Add_Worksheet()
Dim i As Long
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Data" Then
        SheetFound = True
    End If
Next i

If Not SheetFound Then
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Data"
End If
End Sub

High Precision Timer using Windows API

High Precision Timer using Windows API

Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

Sub CodeTimer()
Dim StartTime As Currency, CurrentTime As Currency, TickFrequency As Currency
QueryPerformanceFrequency TickFrequency 'Get ticks per second of the PC
QueryPerformanceCounter StartTime 'Get current tick count(Used before code to time)

'Timed code here

QueryPerformanceCounter CurrentTime 'Get current tick count(Used after code to time)
MsgBox (CurrentTime - StartTime) / TickFrequency 'Returns how many seconds the timed code took to run
End Sub

Get user desktop and make a folder

Get user desktop and make a folder

Dim DeskTop As String
  Dim WSH As Object
  Dim GetDesktopPath As String
  Dim MainFolder As String
  
    Set WSH = CreateObject("WScript.Shell")
    DeskTop = WSH.SpecialFolders("desktop")
    
    GetDesktopPath = DeskTop
    Set WSH = Nothing
    
MainFolder = "Your Folder Name" 'Folder to be created on the desktop
Dim Path As String
Path = GetDesktopPath & "\" & MainFolder &"\"
If Len(Dir(Path, vbDirectory)) = 0 Then
MkDir (Path)
End If

Delete a worksheet

To delete a worksheet titled "Data"

Sub DeleteSheet()
Application.DisplayAlerts = False
  'Replace "Data" with your sheet name
Sheets("Data").Delete
Application.DisplayAlerts = True
End Sub

Detect OS Type

Used to detect if OS Type is Windows or macOS

Sub GetOSType()
    'Get the OS that I am running from
    Dim OSType      As String
    OSType = Application.OperatingSystem
    If OSType Like "*Windows*" Then
        OSType = "Windows"
    Else
        If OSType Like "*Macintosh*" Then
            OSType = "macOS"
        End If
    End If
    'Message box of the detected OS
    MsgBox OSType
End Sub