VB+SQL SEVER2000的一组问题

Question

以下均是在用VB+SQL SEVER2000做设计时遇到的紧急问题：1.如何在按下按钮A的时候执行按钮B的操作？2.如何将DATAGRID控件里显示的东西以EXCEL输出？3.如何将DATAGRID控件里显示的东西直接打印？4.还有就是如何对数据库进行备份和恢复？可否给出详细的解决方案，谢谢。

Answer 1

1、
Private Sub Command1_Click()
    Command2_Click
End SubPrivate Sub Command2_Click()
    MsgBox "按钮B!"
End Sub2、
http://www.microsoft.com/china/community/Column/32.mspx

Answer 2

4、VB实现SQL Server数据库备份/恢复 
'*************************************************************************
'**模 块 名：fBackupDatabase_a
'**描    述：备份数据库,返回出错信息,正常恢复,返回""
'**调    用：fBackupDatabase_a "备份文件名","数据库名"
'**参数说明：
'**          sBackUpfileName  恢复后的数据库存放目录
'**          sDataBaseName    备份的数据名
'**          sIsAddBackup     是否追加到备份文件中
'**说    明：引用Microsoft ActiveX Data Objects 2.x Library
'**创 建 人：邹建
'**日    期：2003年12月09日
'*************************************************************************
Public Function fBackupDatabase_a(ByVal sBackUpfileName$ _
                                , ByVal sDataBaseName$ _
                                , Optional ByVal sIsAddBackup As Boolean = False _
                                ) As String
                                
    Dim iDb As ADODB.Connection
    Dim iConcStr$, iSql$, iReturn$
    
    On Error GoTo lbErr
    
    '创建对象
    Set iDb = New ADODB.Connection
    
    '连接数据库服务器,根据你的情况修改连接字符串
    iConcStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=zj"
    iDb.Open iConcStr
    
    '生成数据库备份语句
    iSql = "backup database [" & sDataBaseName & "]" & vbCrLf & _
            "to disk='" & sBackUpfileName & "'" & vbCrLf & _
            "with description='" & "zj-backup at:" & Date & "(" & Time & ")'" & vbCrLf & _
            IIf(sIsAddBackup, "", ",init")
            
    iDb.Execute iSql
    GoTo lbExit
    
lbErr:
    iReturn = Error
lbExit:
    fBackupDatabase_a = iReturn
End Function'*************************************************************************
'**模 块 名：frestoredatabase_a
'**描    述：恢复数据库,返回出错信息,正常恢复,返回""
'**调    用：frestoredatabase_a "备份文件名","数据库名"
'**参数说明：
'**          sDataBasePath  恢复后的数据库存放目录
'**          sBackupNumber  是从那个备份号恢复
'**          sReplaceExist  指定是否覆盖已经存在的数据
'**说    明：引用Microsoft ActiveX Data Objects 2.x Library
'**创 建 人：邹建
'**日    期：2003年12月09日
'*************************************************************************
Public Function fRestoreDatabase_a(ByVal sBackUpfileName$ _
                                , ByVal sDataBaseName$ _
                                , Optional ByVal sDataBasePath$ = "" _
                                , Optional ByVal sBackupNumber& = 1 _
                                , Optional ByVal sReplaceExist As Boolean = False _
                                ) As String
    
    Dim iDb As ADODB.Connection, iRe As ADODB.Recordset
    Dim iConcStr$, iSql$, iReturn$, iI&
    
    On Error GoTo lbErr
    
    '创建对象
    Set iDb = New ADODB.Connection
    Set iRe = New ADODB.Recordset
    
    '连接数据库服务器,根据你的情况修改连接字符串
    iConcStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=zj"
    iDb.Open iConcStr
    
    '得到还原后的数据库存放目录,如果没有指定,存放到SQL SERVER的DATA目录
    If sDataBasePath = "" Then
        iSql = "select filename from master..sysfiles"
        iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
        iSql = iRe(0)
        iRe.Close
        sDataBasePath = Left(iSql, InStrRev(iSql, "\"))
    End If
    
    '检查数据库是否存在
    If sReplaceExist = False Then
        iSql = "select 1 from master..sysdatabases  where name='" & sDataBaseName & "'"
        iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
        If iRe.EOF = False Then
            iReturn = "数据库已经存在!"
            iRe.Close
            GoTo lbExit
        End If
        iRe.Close
    End If
    
    '关闭用户进程,防止其它用户正在使用数据库,导致数据恢复失败
    iSql = "select spid from master..sysprocesses where dbid=db_id('" & sDataBaseName & "')"
    iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
    While iRe.EOF = False
        iSql = "kill " & iRe(0)
        iDb.Execute iSql
        iRe.MoveNext
    Wend
    iRe.Close
    
    '获取数据库恢复信息
    iSql = "restore filelistonly from disk='" & sBackUpfileName & "'" & vbCrLf & _
        "with file=" & sBackupNumber
    iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
    
    '生成数据库恢复语句
    iSql = "restore database [" & sDataBaseName & "]" & vbCrLf & _
        "from disk='" & sBackUpfileName & "'" & vbCrLf & _
        "with file=" & sBackupNumber & vbCrLf
    With iRe
        While Not .EOF
            iReturn = iRe("PhysicalName")
            iI = InStrRev(iReturn, ".")
            iReturn = IIf(iI = 0, "", Mid(iReturn, iI)) & "'"
            iSql = iSql & ",move '" & iRe("LogicalName") & _
                    "' to '" & sDataBasePath & sDataBaseName & iReturn & vbCrLf
            .MoveNext
        Wend
        .Close
    End With
    iSql = iSql & IIf(sReplaceExist, ",replace", "")
    
    iDb.Execute iSql
    iReturn = ""
    GoTo lbExit
    
lbErr:
    iReturn = Error
lbExit:
    fRestoreDatabase_a = iReturn
End Function
 

Answer 3

1.
Private Sub Command1_Click()
Command2_Click
End Sub

Answer 4

3、用VB自带的报表工具DataReport用excel作报表水晶报表或Active ReportsVB6中用DataReport做报表
微软的，说得很清楚：
http://www.microsoft.com/china/msdn/vbasic/technical/tutorial/tour/data.htm
http://www.microsoft.com/china/msdn/technic/develop/vb/0125h.asp
http://www.yesky.com/20020108/213121.shtml

Answer 5

2、2.如何将DATAGRID控件里显示的东西以EXCEL输出？
dim rst as new adodb.recordset   '记录集对象
dim gxl as excel.application
dim msheet as worksheet
dim i as integer
i=2
set gxl=createobject(" excel.application")
set msheet=gxl.activesheet
gxl.workbooks.add
do while not rst.eof
i=i+1
msheet.cells(1,1)="表名"
msheet.cells(2,1)="字段名1"
msheet.cells(2,2)="字段名2"
msheet.cells(i,1)=rst("字段名1")
msheet.cells(i,2)=rst("字段名2")
rst.movenext
loop
'保存excel表
gxl.activeworkbooks.saveas app.path & "\" filename & ".xls"

Answer 6

2.如何将DATAGRID控件里显示的东西以EXCEL输出？'工程->引用Microsoft ActiveX Data Objects 2.x Library
'工程->引用Microsoft Excel x.0 Object Library
'窗体上放一个CommonDialog、CommandButton
Private Sub Command3_Click()
    Dim pubConn As New ADODB.Connection
    Dim rsTable As New ADODB.Recordset
    Dim strConn As String
    Dim strSQL As String
    Dim AppExcel As Excel.Application
    Dim BookExcel As Excel.Workbook
    Dim ExcelFileName As String
    
    On Error GoTo mErr
    'On Error Resume Next
    
    With cmDialog
        cmDialog.CancelError = True
        .Filter = "Excel|*.xls"
        .DialogTitle = "建立输出文件"
        .ShowSave
        If Err = cdlCancel Then Exit Sub
        ExcelFileName = .FileName
    End With
    
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" & ";Persist Security Info=False"
    pubConn.Open strConn
    rsTable.CursorLocation = adUseClient
    strSQL = "select * from Table1"
    rsTable.Open strSQL, pubConn, adOpenStatic, adLockOptimistic
    
    Set AppExcel = CreateObject("Excel.Application")
    If Dir$(ExcelFileName) = "" Then
        Set AppExcel = New Excel.Application
        AppExcel.Visible = False
        Set BookExcel = AppExcel.Workbooks.Add
        AppExcel.Worksheets(1).Name = Text1.Text             '在Text1中输入表名
        AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsTable
        BookExcel.SaveAs (ExcelFileName)
    Else
        Set BookExcel = AppExcel.Workbooks.Open(ExcelFileName)
        AppExcel.Worksheets(1).Name = Text1.Text             '在Text1中输入表名
        AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsTable
        BookExcel.Save
    End If
    
    AppExcel.Quit
    Set BookExcel = Nothing
    Set AppExcel = Nothing
    rsTable.Close
    Set rsTable = Nothing
    pubConn.Close
    Set pubConn = Nothing
    
    MsgBox "保存完成"
  
Exit Sub
mErr:
    MsgBox Err.Number & "," & Err.Description, vbCritical + vbOKOnly, mTitle
    End
End Sub