Had a Customer wanted to know what Drive letter is for a USB drive Name

that got me thinking  

aaa = Get_Drive_Letter("DIG-FRAME")
msgbox(aaa)

hes the function that will return the Drive letter base on the USB name

Function Get_Drive_Letter(CheckName)
strComputer = "."
Get_Drive_Letter = ""
Set objWMIService = GetObject("winmgmts:" _
   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputer = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Drives = FSO.Drives
For Each DiskDrive In Drives
  If DiskDrive.IsReady Then
    If UCase(Trim(CheckName)) = UCase(Trim(DiskDrive.VolumeName)) Then
      'MsgBox (DiskDrive.driveletter & ":" & DiskDrive.VolumeName)
      Get_Drive_Letter = DiskDrive.driveletter & ":"
      Exit For
    Else
      Get_Drive_Letter = ""
    End If
  End If
Next
End Function

Found out latter he used it to back a 2TB drive that were change each day 

Soundex is a phonetic algorithm for indexing names by sound, as pronounced in English.

Sounddex from wikipedia

Why reinvent the wheel

thanks Christian d'Heureuse his website

Public Function Soundex(ByVal s As String) As String
    ' Computes the "Soundex" value of a string.
    ' This version produces exactly the same results as the Soundex
    ' function of Microsoft SQL Server 2000.
    ' Author: Christian d'Heureuse, chdh@source-code.biz
   Const CodeTab = " 123 12  22455 12623 1 2 2"
   '                abcdefghijklnmopqrstuvwxyz
   If Len(s) = 0 Then Soundex = "0000": Exit Function
   Dim c As Integer
   c = Asc(Mid$(s, 1, 1))
   If c >= 65 And c <= 90 Or c >= 97 And c <= 122 Then
      ' nop
    ElseIf c >= 192 And c <= 214 Or c >= 216 And c <= 246 Or c >= 248 Then
      ' nop
    Else
      Soundex2 = "0000"
      Exit Function
      End If
   Dim ss As String, PrevCode As String
   ss = UCase(Chr(c))
   PrevCode = "?"
   Dim p As Integer: p = 2
   Do While Len(ss) < 4 And p <= Len(s)
      c = Asc(Mid(s, p))
      If c >= 65 And c <= 90 Then
         ' nop
       ElseIf c >= 97 And c <= 122 Then
         c = c - 32
       ElseIf c >= 192 And c <= 214 Or c >= 216 And c <= 246 Or c >= 248 Then
         c = 0
       Else
         Exit Do
         End If
      Dim Code As String: Code = "?"
      If c <> 0 Then
         Code = Mid$(CodeTab, c - 64, 1)
         If Code <> " " And Code <> PrevCode Then ss = ss & Code
         End If
      PrevCode = Code
      p = p + 1
      Loop
   If Len(ss) < 4 Then ss = ss & String$(4 - Len(ss), "0")
   Soundex = ss
   End Function

I use it to look up over 7,000 clients in my Database work well

AA = Soundex("Stephan") = S315
BB = Soundex("Stephen") = S315
CC = Soundex("stefan") = S315
DD = Soundex("mckillen") = M245
EE  = Soundex("mckilen") = M245

differnace spelling of a name give me the same soundex

I have been ask many time what the best way to store hours in a data base.
as hour is a mod 60 what I do store MINS and use the below function to convert the mins to time format so
if a job took me 1:30 I store the min value 90min then if a did and other hour store that as 60 then add the mins up 150min total pass the

total = Mintohrs(150)

total would show 02:30 HrstoMin

Function Mintohrs(Tmin)
    hh = Int(Tmin / 60)
    tt = hh * 60
    mm = Tmin - tt
    Mintohrs = DIG(hh) & ":" & DIG(mm)
End Function

hourtomin

 my other Functions

03:15 = Mintohrs(90+90+15)

I use and other Function I wrote to format the Mins

Function DIG(num)
     if len(num)<>2 then
        DIG ="0" & num 
     else
        DIG = num 
     end if
End Function

some ask me need to know the age of someone to the Month ie 45.5 months don't know why but ....

Function Age(Birth_Date,End_Date)
'***************************************
' Works out the age of to the month
'
'***************************************
Dim Months
Dim Years
Dim Temp
If IsNull(Birth_Date) or Birth_Date ="" Then
    Age=0.0 
else
    Months = DateDiff("m", CDate(Birth_Date), End_Date)
    Years = Int(Months / 12)
    Temp = Years * 12
    If Years = 0 then Years = "" 
    Age =  Years & "." & Months - Temp
End if
End Function

MyAge = age(DOB,now())

I had to Find the Last day on the Month that the hard bit but got thinking why note just find the first day on the next month then -1 day form that so here it is

Function st1month(Tdate)
    st1month = DateSerial(Year(Tdate), Month(Tdate) + 1, 1)
End Function

OK now let find the Last day on month

Function LastDay(Tdate)
    Lastd = dateadd("m",1,st1month(Tdate))
    LastDay = DateAdd("d", -1, Lastd)
End Function

Must have both function in your code.

Some handy function

Function ReportFolderStatus(fldr) As Boolean
   Dim fso, msg
   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FolderExists(fldr)) Then
      ReportFolderStatus = True
   Else
      ReportFolderStatus = False
   End If
   Set fso = Nothing
End Function

Function CreateFolder(FolderName)
On Error Resume Next
   Dim fso, f
   If Not ReportFolderStatus(FolderName) Then
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.CreateFolder(FolderName)
   End If
   Set fso = Nothing
End Function

Sub SaveAction(FullPathFile, FeildName, strEntry, Deleteit)
    'write the data to a log file
    If Deleteit And ReportFileStatus(FullPathFile) Then Kill FullPathFile
    Dim strErrMsg, f, fsoLog
    Set fsoLog = CreateObject("Scripting.FileSystemObject")
    Set f = fsoLog.OpenTextFile(FullPathFile, 8, True, -2)
    Outline = FeildName & ":" & strEntry
    f.WriteLine Outline
    f.Close
    Set fsoLog = Nothing
End Sub

Function ReportFileStatus(filespec)
   Dim fso, msg
   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FileExists(filespec)) Then
      ReportFileStatus = True
      Exit Function
   Else
      ReportFileStatus = False
      Exit Function
   End If
   Set fso = Nothing
End Function

base on the dlookup function in MSaccess

Sub UpLookup(Feild, FeildValue, Table, Crit)
    Dim SQL As String
    Dim DB As Database
    Dim rs As Recordset
    Set DB = CurrentDb
    SQL = ""
    SQL = " SELECT " & Table & ".*"
    SQL = SQL & " FROM " & Table & ""
    SQL = SQL & " WHERE " & Crit
    Set rs = DB.OpenRecordset(SQL)
    If Not rs.EOF Then
        rs.Edit
        rs.Fields(Feild) = FeildValue
        rs.Update
    End If
    rs.Close
End Sub

one function I Like in MSaccess was the Dlookup() when I start written ASP I miss that function so After about a Month I had Written the ASP version It Works for me and help me get data that i miss

 
Function ASPLookup(FieldName,TableName,Crit)
    Dim Dsql , OfeildName, RecordSet, CheckIt
    OfeildName = Trim(Left(Crit, InStr(Crit, "=") - 1))
    CheckIt = Trim(Mid(Crit, InStr(Crit, "=")+1,len(Crit)))
    Dsql = ""
    Dsql = Dsql & "SELECT " & TableName & "." & OfeildName & "," & TableName & "." & FieldName
    Dsql = Dsql & " FROM " & TableName & " "
    Dsql = Dsql & " WHERE (" & TableName & "." & Crit & ");"
    
    if CheckIt ="" or CheckIt="0" or OfeildName ="" then
        ASPLookup = ""
        Exit Function
    Else
    
    end if
    'call writeit("Crit",Crit)
    'call writeit("CheckIt",CheckIt)
    'call writeit("DSQL",DSQL)
    Set RecordSet = Server.CreateObject("ADODB.Recordset")
    RecordSet.Open DSQL, connstring, adOpenKeyset, adLockPessimistic, adCmdText
    If RecordSet.EOF Then
       ASPLookup = ""
       RecordSet.Close
       set RecordSet = nothing
       Exit Function
	Else
       ASPLookup = RecordSet(1)
       RecordSet.Close
       set RecordSet = nothing    
       Exit Function
    End If
End Function

This Function Work like the dlookup(feild,table,where) in MSaccess

name = ASPLookup("surname","Customer","CustomerID=2")

only thing you have todo is create the connstring which is the string point to the MS or SQL dataset

OR

name = ASPLookup("surname","Customer","CustomerID=2 or Customer.login=1")

the Crit after the first must have the table name

check out the writeit Blog

I first wrote this function in lotus 123

off top of heap going back 20+ year  +iif((a1 mod 7)>0,a1-(a1 MOD7)+7,a1)) please don't quote me on this

this would of been one of my first function I wrote

 Public Function WEEKEND(dat) As Date
    If IsNull(dat) Then Exit Function
    dat = DateSerial(Year(dat), Month(dat), Day(dat))
    If dat Mod 7 > 0 Then
    WEEKEND = dat - dat Mod 7 + 7
    Else
    WEEKEND = dat
    End If
 End Function

I know the Above Function works in VB 

Work in 

excel

Msaccess