Code Listing 5: VBA Code for Getting/Setting the Short Date Format
Declarations SectionPrivate 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
|