vb中sql数据库另存为excel,高手请进!

Question

想在一个数据库软件中加入一个把查询出来的sql表另存为excel的功能,请问要怎么写?
小弟菜鸟,有什么需要说明的我会跟贴说明.

Answer 1

Insert Into OpenSet(....)

Answer 2

    Dim wRunFlg             As Byte
    Dim wOutXls             As String
    Dim xlsApp              As Object
    Dim xlsBook             As Workbook
    Dim xlsSheet            As Worksheet
    Dim wLine               As Long
    Dim wSql                As String
    Dim wInv                As Long
    Dim w1                  As Boolean    
    On Error GoTo Err_Exit1
        wOutXls = xls文件保存路径
        If Dir(wOutXls) <> "" Then
            w1 = True
        Else
            Set xlsApp = CreateObject("Excel.Application")  'Excel起動
            Set xlsBook = xlsApp.Workbooks.Add
            xlsBook.SaveAs wOutXls
            xlsBook.Sheets(2).Delete
            xlsBook.Sheets(2).Delete
            xlsBook.Close True
        End If
    End With
    On Error GoTo Err_Exit2
    判断EXCEL是否启动
     没有启动wRunFlg =0
    启动wRunFlg =1
    With Frm_CFS370
        If wRunFlg = 0 Then
            Set xlsApp = CreateObject("Excel.Application")  'Excel起動
        Else
            Set xlsApp = GetObject(, "Excel.Application")
        End If
        xlsApp.Application.Visible = False
        xlsApp.Workbooks.Open (wOutXls)                     'Book起動
        Set xlsBook = xlsApp.ActiveWorkbook
        Set xlsSheet = xlsBook.ActiveSheet
        xlsBook.Sheets(1).Select
        If w1 = True Then
            xlsBook.Sheets(1).Cells.Select
            xlsBook.Sheets(1).Cells.ClearContents
            xlsBook.Sheets(1).Cells.Borders(xlDiagonalDown).LineStyle = xlNone
            xlsBook.Sheets(1).Cells.Borders(xlDiagonalUp).LineStyle = xlNone
            xlsBook.Sheets(1).Cells.Borders(xlEdgeLeft).LineStyle = xlNone
            xlsBook.Sheets(1).Cells.Borders(xlEdgeTop).LineStyle = xlNone
            xlsBook.Sheets(1).Cells.Borders(xlEdgeBottom).LineStyle = xlNone
            xlsBook.Sheets(1).Cells.Borders(xlEdgeRight).LineStyle = xlNone
            xlsBook.Sheets(1).Cells.Borders(xlInsideVertical).LineStyle = xlNone
            xlsBook.Sheets(1).Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
            xlsSheet.Range("A1").Select
        End If
        初始化EXCEL
        xlsBook.Sheets(1).Name = Format(Now, "yyyymmdd")
        xlsSheet.Range("A1").Value = "AAA"
        xlsSheet.Range("B1").Value = "BBB"
        xlsSheet.Columns("C:C").ColumnWidth = 17.5
        xlsSheet.Range("C1").Value = "CCC"
        xlsSheet.Range("D1").Value = "DDD"
        xlsSheet.Range("E1").Value = "EEE"
        xlsSheet.Range("F1").Value = "FFF"
        xlsSheet.Range("G1").Value = "GGG"
        xlsSheet.Columns("H:H").ColumnWidth = 2
        xlsSheet.Range("H1").Value = "HHH"
        xlsSheet.Columns("I:I").ColumnWidth = 14.5
        xlsSheet.Range("I1").Value = "III"
        xlsSheet.Columns("J:J").ColumnWidth = 25
        xlsSheet.Range("J1").Value = "JJJ"
        xlsSheet.Columns("K:K").ColumnWidth = 25
        xlsSheet.Range("K1").Value = "KKK"
        xlsSheet.Columns("L:L").ColumnWidth = 5.5
        xlsSheet.Range("L1").Value = "LLL"
        xlsSheet.Columns("M:M").ColumnWidth = 5.5
        xlsSheet.Range("M1").Value = "MMM"
        xlsSheet.Columns("N:N").ColumnWidth = 7.5
        xlsSheet.Range("N1").Value = "NNN"
        xlsSheet.Columns("O:O").ColumnWidth = 5.5
        xlsSheet.Range("O1").Value = "OOO"
        xlsSheet.Columns("P:P").ColumnWidth = 7.5
        xlsSheet.Range("P1").Value = "PPP"
             
打开数据库连接
        wSql = "查询语句"
 执行查询的SQl语句，使用recordset保存
        wLine = 2
        If wInv = False Then
            Do While r1.EOF = False
                xlsSheet.Cells(wLine, 1).Value = Trim(r1!AAA& "")
                xlsSheet.Cells(wLine, 2).Value = Trim(r1!BBB& "")
                xlsSheet.Cells(wLine, 3).Value = Trim(r1!CCC& "")
                xlsSheet.Cells(wLine, 4).Value = Trim(r1!DDD& "")
                xlsSheet.Cells(wLine, 5).Value = Trim(r1!EEE& "")
                xlsSheet.Cells(wLine, 6).Value = Trim(r1!FFF& "")
                xlsSheet.Cells(wLine, 7).Value = Trim(r1!GGG& "")
                xlsSheet.Cells(wLine, 8).Value = Trim(r1!HHH& "")
                xlsSheet.Cells(wLine, 9).Value = Trim(r1!III& "")
                xlsSheet.Cells(wLine, 10).Value = Trim(r1!JJJ& "")
                xlsSheet.Cells(wLine, 11).Value = Trim(r1!KKK& "")
                xlsSheet.Cells(wLine, 12).Value = Val(r1!LLL& "")
                xlsSheet.Cells(wLine, 13).Value = Val(r1!MMM & "")
                xlsSheet.Cells(wLine, 14).Value = Val(r1!NNN & "")
                xlsSheet.Cells(wLine, 15).Value = Val(r1!OOO & "")
                xlsSheet.Cells(wLine, 16).Value = Val(r1!PPP & "")
                wLine = wLine + 1
                r1.MoveNext
            Loop
        End If
        wLine = wLine - 1
        With xlsSheet.Range("A1:P" & wLine)
             .Borders.LineStyle = xlContinuous
             .Borders.ColorIndex = xlAutomatic
             .Borders(xlDiagonalDown).LineStyle = xlNone
             .Borders(xlDiagonalUp).LineStyle = xlNone
             .Borders(xlEdgeTop).Weight = xlMedium
             .Borders(xlEdgeBottom).Weight = xlThin
             .Borders(xlInsideVertical).Weight = xlThin
        End With
        xlsBook.Save
        xlsBook.Close True
        Set xlsSheet = Nothing
        Set xlsBook = Nothing
        xlsApp.Application.Quit
        xlsApp.Quit
        Set xlsApp = Nothing
    End With  关闭数据库连接
    Exit FunctionErr_Exit1:
...
Err_Exit2:
...
Err_Exit3:
...         End Function

Answer 3

 On Error GoTo Err_Exit1
无效外部过程?还有没有 Function怎么有End Function?

Answer 4

 On Error GoTo Err_Exit1 
是我写的错误捕获，你也可以去掉的。
Err_Exit1: 
... 
Err_Exit2: 
... 
Err_Exit3: 
...         End Function
是我写的错误捕获代码，这里我省略掉了。希望你可以灵活的看看这些代码。 Dim wRunFlg             As Byte 
    Dim wOutXls             As String 
    Dim xlsApp              As Object 
    Dim xlsBook             As Workbook 
    Dim xlsSheet            As Worksheet 
    Dim wLine               As Long 
    Dim wSql                As String 
    Dim wInv                As Long 
    Dim w1                  As Boolean     
        wOutXls = xls文件保存路径 
        If Dir(wOutXls)  <> "" Then 
            w1 = True 
        Else 
            Set xlsApp = CreateObject("Excel.Application")  'Excel起動 
            Set xlsBook = xlsApp.Workbooks.Add 
            xlsBook.SaveAs wOutXls 
            xlsBook.Sheets(2).Delete 
            xlsBook.Sheets(2).Delete 
            xlsBook.Close True 
        End If 
    End With 
    判断EXCEL是否启动 
     没有启动wRunFlg =0 
    启动wRunFlg =1 
    With Frm_CFS370 
        If wRunFlg = 0 Then 
            Set xlsApp = CreateObject("Excel.Application")  'Excel起動 
        Else 
            Set xlsApp = GetObject(, "Excel.Application") 
        End If 
        xlsApp.Application.Visible = False 
        xlsApp.Workbooks.Open (wOutXls)                     'Book起動 
        Set xlsBook = xlsApp.ActiveWorkbook 
        Set xlsSheet = xlsBook.ActiveSheet 
        xlsBook.Sheets(1).Select 
        If w1 = True Then 
            xlsBook.Sheets(1).Cells.Select 
            xlsBook.Sheets(1).Cells.ClearContents 
            xlsBook.Sheets(1).Cells.Borders(xlDiagonalDown).LineStyle = xlNone 
            xlsBook.Sheets(1).Cells.Borders(xlDiagonalUp).LineStyle = xlNone 
            xlsBook.Sheets(1).Cells.Borders(xlEdgeLeft).LineStyle = xlNone 
            xlsBook.Sheets(1).Cells.Borders(xlEdgeTop).LineStyle = xlNone 
            xlsBook.Sheets(1).Cells.Borders(xlEdgeBottom).LineStyle = xlNone 
            xlsBook.Sheets(1).Cells.Borders(xlEdgeRight).LineStyle = xlNone 
            xlsBook.Sheets(1).Cells.Borders(xlInsideVertical).LineStyle = xlNone 
            xlsBook.Sheets(1).Cells.Borders(xlInsideHorizontal).LineStyle = xlNone 
            xlsSheet.Range("A1").Select 
        End If 
        初始化EXCEL 
        xlsBook.Sheets(1).Name = Format(Now, "yyyymmdd") 
        xlsSheet.Range("A1").Value = "AAA" 
        xlsSheet.Range("B1").Value = "BBB" 
        xlsSheet.Columns("C:C").ColumnWidth = 17.5 
        xlsSheet.Range("C1").Value = "CCC" 
        xlsSheet.Range("D1").Value = "DDD" 
        xlsSheet.Range("E1").Value = "EEE" 
        xlsSheet.Range("F1").Value = "FFF" 
        xlsSheet.Range("G1").Value = "GGG" 
        xlsSheet.Columns("H:H").ColumnWidth = 2 
        xlsSheet.Range("H1").Value = "HHH" 
        xlsSheet.Columns("I:I").ColumnWidth = 14.5 
        xlsSheet.Range("I1").Value = "III" 
        xlsSheet.Columns("J:J").ColumnWidth = 25 
        xlsSheet.Range("J1").Value = "JJJ" 
        xlsSheet.Columns("K:K").ColumnWidth = 25 
        xlsSheet.Range("K1").Value = "KKK" 
        xlsSheet.Columns("L:L").ColumnWidth = 5.5 
        xlsSheet.Range("L1").Value = "LLL" 
        xlsSheet.Columns("M:M").ColumnWidth = 5.5 
        xlsSheet.Range("M1").Value = "MMM" 
        xlsSheet.Columns("N:N").ColumnWidth = 7.5 
        xlsSheet.Range("N1").Value = "NNN" 
        xlsSheet.Columns("O:O").ColumnWidth = 5.5 
        xlsSheet.Range("O1").Value = "OOO" 
        xlsSheet.Columns("P:P").ColumnWidth = 7.5 
        xlsSheet.Range("P1").Value = "PPP" 
              
打开数据库连接 
        wSql = "查询语句" 
 执行查询的SQl语句，使用recordset保存 
        wLine = 2 
        If wInv = False Then 
            Do While r1.EOF = False 
                xlsSheet.Cells(wLine, 1).Value = Trim(r1!AAA& "") 
                xlsSheet.Cells(wLine, 2).Value = Trim(r1!BBB& "") 
                xlsSheet.Cells(wLine, 3).Value = Trim(r1!CCC& "") 
                xlsSheet.Cells(wLine, 4).Value = Trim(r1!DDD& "") 
                xlsSheet.Cells(wLine, 5).Value = Trim(r1!EEE& "") 
                xlsSheet.Cells(wLine, 6).Value = Trim(r1!FFF& "") 
                xlsSheet.Cells(wLine, 7).Value = Trim(r1!GGG& "") 
                xlsSheet.Cells(wLine, 8).Value = Trim(r1!HHH& "") 
                xlsSheet.Cells(wLine, 9).Value = Trim(r1!III& "") 
                xlsSheet.Cells(wLine, 10).Value = Trim(r1!JJJ& "") 
                xlsSheet.Cells(wLine, 11).Value = Trim(r1!KKK& "") 
                xlsSheet.Cells(wLine, 12).Value = Val(r1!LLL& "") 
                xlsSheet.Cells(wLine, 13).Value = Val(r1!MMM & "") 
                xlsSheet.Cells(wLine, 14).Value = Val(r1!NNN & "") 
                xlsSheet.Cells(wLine, 15).Value = Val(r1!OOO & "") 
                xlsSheet.Cells(wLine, 16).Value = Val(r1!PPP & "") 
                wLine = wLine + 1 
                r1.MoveNext 
            Loop 
        End If 
        wLine = wLine - 1 
        With xlsSheet.Range("A1:P" & wLine) 
             .Borders.LineStyle = xlContinuous 
             .Borders.ColorIndex = xlAutomatic 
             .Borders(xlDiagonalDown).LineStyle = xlNone 
             .Borders(xlDiagonalUp).LineStyle = xlNone 
             .Borders(xlEdgeTop).Weight = xlMedium 
             .Borders(xlEdgeBottom).Weight = xlThin 
             .Borders(xlInsideVertical).Weight = xlThin 
        End With 
        xlsBook.Save 
        xlsBook.Close True 
        Set xlsSheet = Nothing 
        Set xlsBook = Nothing 
        xlsApp.Application.Quit 
        xlsApp.Quit 
        Set xlsApp = Nothing 
    End With   关闭数据库连接 
    Exit Function 

Answer 5

需要引用什么 ActiveX 对象吗,这段代码.?

Answer 6

引用:
MicroSoft Excel 11.0 Object Libaray