简单问题=白给分,先答的先得

Question

大哥们,如何将2个SQL表连成一个表,比如1个表为 01(编号) | 张三(姓名),另一个表为 01(编号) |100(数学)|81(语文),然后生成一个表为01(编号)|张三(姓名)|100(数学)|81(语文),然后将这个表保存到本地EXECL表中,表名为当前日期,如果这个表存在则追加记录,谢谢?

Answer 1

1、strSQL="select 表1.编号,表1.姓名,表2.数学,表2.语文 from 表1 inner join 表2
   on 表1.编号=表2.编号"2、引用自小马哥
调用方法：ExporToExcel strSQlPublic Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
    Dim Rs_Data As New ADODB.Recordset
    Dim Irowcount As Integer
    Dim Icolcount As Integer
    Dim cn As New ADODB.Connection
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb"    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection=cn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .Source = strOpen
        .Open
    End With
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = Nothing
    
End Function3、判断已存在的Excel表有多少条记录，然后在确定上述函数中的插入数据的起始位置
      Dim rs As ADODB.Recordset
      Set rs = New ADODB.Recordset
      Dim cn As String      rs.CursorLocation = adUseClient
      rs.CursorType = adOpenKeyset
      rs.LockType = adLockBatchOptimistic      cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb"
      rs.Open "SELECT * FROM [sheet1$]", cn
      msgbox rs.RecordCount

Answer 2

bcp  可以实现数据的导入导出。//导入  
EXEC  master..xp_cmdshell  'bcp  test.dbo.P_Aspect  in  c:\test.xls  -c  -q  -S"servername"  -U"sa"  -P""'    
 
//导出  
EXEC master..xp_cmdshell 'bcp "select 表1.编号,表1.姓名,表2.数学,表2.语文 from 库.dbo.表1 a，库.dbo.表2 b where a.编号=b.编号" queryout c:\test.xls -c -Sservername -Usa -Ppassword'

Answer 3

若已经存在：
insert into OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
  'Data Source="c:\test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...[sheet1$]
select 表1.编号,表1.姓名,表2.数学,表2.语文 
from 表1 a,表2 b 
where a.编号=b.编号

Answer 4

'*************************************************************************
'**
'** VB将数据导出到EXCEL,没有安装EXCEL的一样也可以导出.
'**
'** 调用方式: s_Export2Excel(Ado.Recordset) 或 s_Export2Excel(Rds.RecordSet)
'** 支持 Rds 与 Ado 的记录导出
'**
'*************************************************************************'导出ADO记录集到EXCEL
Public Function f_Export2Excel(ByVal sRecordSet As ADODB.Recordset, ByVal sExcelFileName$ _
        , Optional ByVal sTableName$, Optional ByVal sOverExist As Boolean = False) As Boolean
    
    'On Error GoTo lbErr
    
    Dim iConcStr, iSql$, iFdlist$, iDb As ADODB.Connection
    Dim iI&, iFdType$, j, TmpField, FileName
    Dim iRe As Boolean    
    '检查文件名
    If Dir(sExcelFileName) <> "" Then
        If sOverExist Then
            Kill sExcelFileName
        Else
            iRe = False
            GoTo lbExit
        End If
    End If
    
    '生成创建表的SQL语句
    With sRecordSet
        For iI = 0 To .Fields.Count - 1
            iFdType = f_FieldType(.Fields(iI).Type)
            Select Case iFdType
                Case "char", "varchar", "nchar", "nvarchar", "varbinary"
                    If .Fields(iI).DefinedSize > 255 Then
                        iSql = iSql & ",[" & .Fields(iI).Name & "] text"
                    Else
                        iSql = iSql & ",[" & .Fields(iI).Name & "] " & iFdType & _
                            "(" & .Fields(iI).DefinedSize & ")"
                    End If
                Case "image"
                Case Else
                    iSql = iSql & ",[" & .Fields(iI).Name & "] " & iFdType
            End Select
        Next
        
        If sTableName = "" Then sTableName = .Source
        iSql = "create table [" & sTableName & "](" & Mid(iSql, 2) & ")"
    End With
    
    '数据库连接字符串
    iConcStr = "DRIVER={Microsoft Excel Driver (*.xls)};DSN='';FIRSTROWHASNAMES=1;READONLY=FALSE;" & _
            "CREATE_DB=""" & sExcelFileName & """;DBQ=" & sExcelFileName
    
    '创建Excel文件,并创建表
    Set iDb = New ADODB.Connection
    iDb.Open iConcStr
    iDb.Execute iSql
    
    '插入数据
    With sRecordSet
        .MoveFirst
        While .EOF = False
            iSql = ""
            iFdlist = ""
            For iI = 0 To .Fields.Count - 1
                iFdType = f_FieldType(.Fields(iI).Type)
                If iFdType <> "image" And IsNull(.Fields(iI).Value) = False Then
                    iFdlist = iFdlist & ",[" & .Fields(iI).Name & "]"
                    Select Case iFdType
                        Case "char", "varchar", "nchar", "nvarchar", "text"
                            iSql = iSql & ",'" & .Fields(iI).Value & "'"
                        Case "datetime"
                            iSql = iSql & ",#" & .Fields(iI).Value & "#"
                        Case "image"
                        Case Else
                            iSql = iSql & "," & .Fields(iI).Value
                    End Select
                End If
            Next
            iSql = "insert into [" & sTableName & "](" & _
                Mid(iFdlist, 2) & ") values(" & Mid(iSql, 2) & ")"
            iDb.Execute iSql
            .MoveNext
        Wend
    End With    '处理完毕,关闭数据库
    iDb.Close
    Set iDb = Nothing
    
    MsgBox "已经将数据保存到 [ " & sExcelFileName & " ]", 64
    iRe = True
    GoTo lbExitlbErr:
    MsgBox "发生错误:" & Err.Description & vbCrLf & _
        "错误代码:" & Err.Number, 64, "错误"
lbExit:
    f_Export2Excel = iRe
End Function'得到所有数据类型,有些数据类型EXCEL不支持,已经替换掉
Public Function f_FieldType$(ByVal sType&)
    Dim iRe$
    Select Case sType
        Case 2, 3, 20
            iRe = "int"
        Case 5
            iRe = "float"
        Case 6
            iRe = "money"
        Case 131
            iRe = "numeric"
        Case 4
            iRe = "real"
        Case 128
            iRe = "binary"
        Case 204
           iRe = "varbinary"
        Case 11
            iRe = "bit"
        Case 129, 130
            iRe = "char"
        Case 17, 72, 131, 200, 202, 204
            iRe = "varchar"
        Case 201, 203
            iRe = "text"
        Case 7, 135
            iRe = "datetime"
        Case 205
            iRe = "image"
        Case 128
            iRe = "timestamp"
    End Select
    f_FieldType = iRe
End Function
'调用测试
Sub test()
    Dim iRe As ADODB.Recordset
    Dim iConc As String
    
    iConc.Open "Provider=SQLOLEDB;Data Source=servername;User Id=sa;PassWord=******;Initial Catalog=testdb"
        
    Set iRe = New ADODB.Recordset
    iRe.Open "维护员", iConc, adOpenKeyset, adLockOptimistic
    f_Export2Excel iRe, "c:\b.xls", , True
    iRe.Close
End Sub