Option Explicit
Public g_Conn As Connection '当前活动连接
Public g_username As String '当前登陆用户
Public g_showdate As Date '登陆时间
'系统由此启动
Sub main()
Dim msg As String
On Error Resume Next
msg = connecttodatabase("sdcl.mdb")
If msg <> "" Then
MsgBox "连接数据库失败" & msg, 16, "登陆"
End
End If
frmmain.Show vbModal
End Sub
'连接到数据库
Public Function connecttodatabase(strFileName As String) As String
On Error GoTo err_conn
Set g_Conn = New Connection
With g_Conn
.CursorLocation = adUseClient
.CommandTimeout = 10
'连接到数据库
.ConnectionString = "provider=microsoft.jet.oledb.4.0;password='';" & _
"data source=" & App.Path & "\" & strFileName
.Open
End With
connecttodatabase = ""
Exit Function
err_conn:
connecttodatabase = Err.Description
End Function
'替换单引号
Function realstring(strsrc As String) As String
strsrc = Replace(strsrc, "'", "''")
End Function
‘’‘’以下为frmmain内容
Private Sub CmdInput_Click()
On Error Resume Next
Dim strsql As String
Adodc1.LockType = adLockBatchOptimistic
Adodc1.ConnectionString = g_Conn.ConnectionString
strsql = "Select 站号,后尺下丝,后尺上丝,前尺下丝,前尺上丝,后尺黑面,后尺红面,前尺黑面,前尺红面 From sdcl "
Adodc1.RecordSource = strsql
Adodc1.Refresh
DataGrid1.ReBind
'导出到Excel文件中
Dim rstCount As Long '记录行数
Dim rstField As Long '记录列
rstCount = Record.RecordCount
rstField = Record.Fields.Count
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
'Dim ArrTemp() As String
xlApp.Visible = False
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(App.Path & "\three.XLS")
Set xlSheet = xlBook.Worksheets(1)
xlBook.Close '---------不按内容变化关闭
xlApp.Quit '--------关闭创建的文件
Set xlBook = Nothing '------释放对象中的值
Set xlApp = Nothing
Set xlSheet = Nothing
If Not (Record Is Nothing) Then
Record.Close
Set Record = Nothing
End If
End Sub
Private Sub Form_Load()
With DataGrid1
.Top = (frmthree.Height - .Height) / 8
.Left = (frmthree.Width - .Width) / 4
.Width = 10000
.Height = frmthree.Height / 2
.AllowAddNew = True
.AllowDelete = True
.HeadFont = "30"
.HeadFont.Bold = True
.Font.Size = "12"
.Font.Name = "宋体"
.Columns(0).Width = 800
.Columns(i).Alignment = dbgCenter
For i = 1 To 8
.Columns(i).Width = 1100
.Columns(i).NumberFormat = "#0.000"
.Columns(i).Alignment = dbgCenter
Next i
End With
End Sub