将系统日期自动改为YYYY.MM.DD的代码

Option Compare Database
Option Explicit

Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Public Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Public Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long
'设置短日期格式
Public Const LOCALE_SSHORTDATE = &H1F
Public Const LOCALE_SDATE = &H1D

'下面的过程可以帮你达到目的

Sub setshortdate()

    Dim llocal As Long
    Dim sa     As String
    Dim lOk    As Long
    Dim setlocalinfo As Variant
    On Error GoTo ErrShow
    sa = Space(20)
    llocal = GetUserDefaultLCID()
    lOk = GetLocaleInfo(llocal, LOCALE_SSHORTDATE, ByVal sa, 20)
    If Trim(sa) <> "yyyy-MM-dd" Then
        MsgBox "您的系统日期不是(YYYY-MM-DD)格式,点击确定,自动更改格式"
        'If MsgBox("您的系统日期不是(YYYY-MM-DD)格式,强烈建议您将它修改成该格式," & Chr(10) _
         & "否则软件可能会出现运行障碍!" _
         & Chr(10) & Chr(10) & "点击'是'将自动为您修改。", vbQuestion + vbYesNo, "忠告") = vbYes Then
        sa = "yyyy-MM-dd"
        llocal = GetUserDefaultLCID()
        SetLocaleInfo llocal, LOCALE_SSHORTDATE, ByVal sa
        'End If
    End If
    sa = Space(2)
    lOk = GetLocaleInfo(llocal, LOCALE_SDATE, ByVal sa, 2)
    If Trim(sa) <> "-" Then
        sa = "-"
        lOk = SetLocaleInfo(llocal, LOCALE_SDATE, ByVal sa)
    End If
    setlocalinfo = True
    Exit Sub
ErrShow:
    MsgBox "系统日期不能自动设置为(2002-01-01)的格式" & vbCrLf & "请用手工先把系统日期改为如(2002-01-01)的格式,再运行本系统!"
End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值