📄 frmmovefile.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmMoveFile
BorderStyle = 3 'Fixed Dialog
Caption = "文书转移"
ClientHeight = 5820
ClientLeft = 45
ClientTop = 330
ClientWidth = 7710
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5820
ScaleWidth = 7710
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSComCtl2.UpDown UpDown1
Height = 285
Left = 5160
TabIndex = 18
Top = 540
Width = 240
_ExtentX = 450
_ExtentY = 503
_Version = 393216
Enabled = -1 'True
End
Begin VB.DirListBox DirPath
Height = 3030
Left = 4770
TabIndex = 8
Top = 1890
Width = 2685
End
Begin VB.ComboBox cmbImgPath
Height = 300
Left = 330
Style = 2 'Dropdown List
TabIndex = 4
Top = 1500
Width = 3000
End
Begin MSComctlLib.ListView lvwDiskSpace
Height = 3045
Left = 300
TabIndex = 3
Top = 1890
Width = 4365
_ExtentX = 7699
_ExtentY = 5371
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin VB.Frame Frame
Height = 4905
Left = 120
TabIndex = 2
Top = 150
Width = 7485
Begin VB.CheckBox chkSSSQ
Caption = "Check2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 200
Left = 2430
TabIndex = 17
Top = 450
Width = 200
End
Begin VB.CheckBox chkDate
Caption = "Check1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 200
Left = 2430
TabIndex = 16
Top = 810
Width = 200
End
Begin VB.DriveListBox Drive
Height = 300
Left = 4650
TabIndex = 15
Top = 1350
Width = 2685
End
Begin VB.TextBox txtSSSQ1
Height = 300
Left = 3660
TabIndex = 5
Text = "Text1"
Top = 390
Width = 1380
End
Begin MSComCtl2.DTPicker DTPDate1
Height = 300
Left = 3660
TabIndex = 10
Top = 780
Width = 1680
_ExtentX = 2963
_ExtentY = 529
_Version = 393216
Format = 62259201
CurrentDate = 36268
End
Begin MSComCtl2.DTPicker DTPDate2
Height = 300
Left = 5640
TabIndex = 11
Top = 780
Width = 1680
_ExtentX = 2963
_ExtentY = 529
_Version = 393216
Format = 62259201
CurrentDate = 36268
End
Begin MSComCtl2.UpDown UpDown2
Height = 285
Left = 7020
TabIndex = 19
Top = 390
Width = 240
_ExtentX = 450
_ExtentY = 503
_Version = 393216
Enabled = -1 'True
End
Begin VB.TextBox txtSSSQ2
Height = 300
Left = 5640
TabIndex = 6
Text = "Text2"
Top = 390
Width = 1380
End
Begin VB.Label lblCaption
Caption = "请选择要转移的文书"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 240
TabIndex = 14
Top = 450
Width = 2025
End
Begin VB.Label Label3
Caption = "导入日期从 到"
Height = 225
Left = 2700
TabIndex = 13
Top = 840
Width = 2955
End
Begin VB.Label lblSSSQ
Caption = "所属时期从 到"
Height = 225
Left = 2700
TabIndex = 12
Top = 450
Width = 2955
End
Begin VB.Label Label2
Caption = "转移到新目录"
Height = 225
Left = 3450
TabIndex = 9
Top = 1410
Width = 1125
End
Begin VB.Label Label1
Caption = "从当前目录"
Height = 225
Left = 210
TabIndex = 7
Top = 1110
Width = 1005
End
End
Begin VB.CommandButton cmdCancel
Caption = " 取消(&C)"
Height = 375
Left = 6090
TabIndex = 1
Top = 5250
Width = 1500
End
Begin VB.CommandButton cmdMove
Caption = " 开始转移(&S)"
Height = 375
Left = 4590
TabIndex = 0
Top = 5250
Width = 1500
End
End
Attribute VB_Name = "frmMoveFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rstImgPath As ADODB.Recordset
Private Sub chkDate_Click()
If ChkDate.Value = vbChecked Then
DTPDate1.Enabled = True
DTPDate2.Enabled = True
Else
DTPDate1.Enabled = False
DTPDate2.Enabled = False
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdMove_Click()
Dim i As Integer
Dim Msg As String
Dim DestPath As String
Dim strSQL As String
Dim Fso As FileSystemObject
Dim Fs
Dim MoveError As Boolean
'取得目的路径
If Right(DirPath.Path, 1) <> "\" Then
DestPath = DirPath.Path & "\"
Else
DestPath = DirPath.Path
End If
'检查源目录及目标目录是否合法
If Trim(cmbImgPath.Text) = DestPath Then
MsgBox "转移到同一目录没有意义,请选择其他目录!", vbInformation
Exit Sub
End If
If Trim(cmbImgPath.Text) = vbNullString Then
MsgBox "请选择要移动的目录!", vbInformation
cmbImgPath.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
'生成查询语句
Dim ImgPath As String
If Right(cmbImgPath.Text, 1) <> "\" Then
ImgPath = Trim(cmbImgPath.Text) & "\"
Else
ImgPath = Trim(cmbImgPath.Text)
End If
strSQL = "SELECT * FROM sys_Image" & _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -