📄 mdlgeneral.bas
字号:
Attribute VB_Name = "mdlGeneral"
Option Explicit
'Task: Create a multi-level directory structure using CreateDirectory API call
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
'use the following subroutine
Public Sub CreateNewDirectory(NewDirectory As String)
Dim sDirTest As String
Dim SecAttrib As SECURITY_ATTRIBUTES
Dim bSuccess As Boolean
Dim spath As String
Dim iCounter As Integer
Dim sTempDir As String
iCounter = 0
spath = NewDirectory
If Right(spath, Len(spath)) <> "\" Then
spath = spath & "\"
End If
iCounter = 1
Do Until InStr(iCounter, spath, "\") = 0
iCounter = InStr(iCounter, spath, "\")
sTempDir = Left(spath, iCounter)
sDirTest = Dir(sTempDir)
iCounter = iCounter + 1
'create directory
SecAttrib.lpSecurityDescriptor = &O0
SecAttrib.bInheritHandle = False
SecAttrib.nLength = Len(SecAttrib)
bSuccess = CreateDirectory(sTempDir, SecAttrib)
Loop
End Sub
Public Function meStateChange(ByVal vPreState As eEditState, ByVal bChanged As Boolean) _
As eEditState
Dim s As eEditState
s = vPreState
If bChanged Then
If s = meEditNormal Then
s = meEditEnabled
Else
s = meEditFinished
End If
Else
s = meEditNormal
End If
meStateChange = s
End Function
Public Sub meAutoCreateTableDef_tblQX()
Static EditState As eEditState '
Dim bCopyEnabled As Boolean
On Error Resume Next
'*****
bCopyEnabled = CBool(Weekday(Date) = vbSunday)
EditState = meStateChange(EditState, bCopyEnabled)
If EditState = meEditEnabled Then
'备份数据库
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -