Code Listing 5: VBA Code for Getting/Setting the Short Date Format

Declarations Section
Private Declare Function GetProfileString _
  Lib "kernel32" _
  Alias "GetProfileStringA" _
  (ByVal strSection As String, _
   ByVal strKeyName As String, _
   ByVal strDefault As String, _
   ByVal strReturned As String, _
   ByVal intSize As Long) _
  As Long
   
Private Declare Function WriteProfileString _
  Lib "kernel32" _
  Alias "WriteProfileStringA" _
  (ByVal strSection As String, _
   ByVal strKeyName As String, _
   ByVal strValue As String) _
  As Long

Procedures

Private Function WinINIWriteSetting( _
  strSection As String, _
  strKeyName As String, _
  strValue As String) _
  As Integer
  ' Comments  : Writes the specified value to WIN.INI
  ' Parameters: strSection - Section to write into
  '             strKeyName - Key to write into
  '             strValue - Value to write
  ' Returns   : True if successful, False otherwise
  '
  Dim lngStatus As Long

  lngStatus = WriteProfileString(strSection, strKeyName, strValue)

  WinINIWriteSetting = (lngStatus <> 0)

PROC_EXIT:
  Exit Function
  
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "WinINIWriteSetting"
  Resume PROC_EXIT
  
End Function

Private Function WinINIGetSetting( _
  strSection As String, _
  strKeyName As String) _
  As String
  ' Comments  : Returns a string value from the WIN.INI file
  ' Parameters: strSection - Name of the section to look in
  '             strKeyName - Name of the key to look for
  ' Returns   : String value
  '
  Dim strBuffer As String * 256
  Dim intSize As Integer

  On Error GoTo PROC_ERR
  
  intSize = GetProfileString( _
    strSection, strKeyName, "", strBuffer, 256)

  WinINIGetSetting = Left$(strBuffer, intSize)

PROC_EXIT:
  Exit Function
  
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "WinINIGetSetting"
  Resume PROC_EXIT
  
End Function

Public Function ShowCurrentShortDate() As String
  ' Comments  : Returns the current control panel short date setting
  ' Parameters: None
  ' Returns   : String
  '
  On Error GoTo PROC_ERR
  
  ShowCurrentShortDate = WinINIGetSetting("intl", "sshortdate")

PROC_EXIT:
  Exit Function
  
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "ShowCurrentShortDate"
  Resume PROC_EXIT
  
End Function

Public Function SetShortDateFormat(strIn As String) As String
  ' Comments  : Sets the control panel short date setting
  ' Parameters: strIn - Format to use, e.g. mm/dd/yyyy
  ' Returns   : New value or <error>
  '
  Dim fOk As Integer

  On Error GoTo PROC_ERR

  fOk = WinINIWriteSetting("intl", "sshortdate", strIn)

  If fOk Then
    SetShortDateFormat = strIn
  Else
    SetShortDateFormat = "<error>"
  End If

PROC_EXIT:
  Exit Function
  
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "SetShortDateFormat"
  Resume PROC_EXIT
  
End Function

Back to main page