VB导出到EXCEL

EXEC master..xp_cmdshell 'bcp "Select * from pubs..jobs" queryout c:\Out.txt -c -SHTSQL02 -Uitsa -Psa1234 ' 

                                 strSQL = "master..xp_cmdshell 'bcp "select appr_status,BATCH_NO,REF_NO,ITEM_NO,ITEM_DESCE,oms_itemno,ITEM_GRP,MODEL_NO,CUST_PN,REV,DomeSale, " & _

                "MANU_NAME,MANU_PN,PROCUR,SPEC_PROCU,UOM,NET_W,NET_UNIT,CUST_CODE,Safe_Mat,mold_code, " & _

                "material_type,factory_code,item1,item2,item3,item4,item5,item6,item7,item8 ,i_date,by_user,export_fg,  conrohs = case itemmstr.rohs when 1 then 'ROHSR0' when 2 then 'ROHSR1' when 3 then 'ROHSR2' when 4 then 'ROHSRE' else '' end,suggest_itemno,batchmgt From  itemmstr where '" & strRefFrom & "'<=REF_NO and REF_NO<='" & strRefTo & "' order by REF_NO " queryout c:\temp\itemmstr.xls  -c -SHTSQL02 -Usa -Phtit2005'"

                             cn.Execute (strSQL)

        Dim xlApp           As Excel.Application

        Dim xlBook          As Excel.Workbook

        Dim xlSheet         As Excel.Worksheet

        Dim xlRange         As Excel.Range

        

        Set xlApp = CreateObject("Excel.Application")

        Set xlBook = xlApp.Workbooks.Add

        Set xlSheet = xlBook.Worksheets(1)



        ' 设置统计信息

        With xlSheet

            .Cells.Font.Name = "宋体"

            .Cells.Font.Size = 12

            .Range(.Cells(1, 1), .Cells(1, 2)).Font.Bold = True

            .Cells(1, 1) = "支出统计"

            .Cells(2, 1) = "统计单位："

            .Cells(2, 2) = sTotalTimeType

            .Cells(3, 1) = lblOutFromTodate.Caption ' 统计日期期间

            .Cells(4, 1) = "金额："

            .Cells(4, 2) = sMoney

            .Cells(5, 1) = "金额类型："

            .Cells(5, 2) = sMoneyValueType

            .Cells(6, 1) = "支出类型："

            .Cells(6, 2) = sType

            .Cells(7, 1) = "小分类："

            .Cells(7, 2) = sTypeSmall

            .Cells(8, 1) = "浪费的钱："

            .Cells(8, 2) = sLangfei

        End With

        

        Dim iBaseNum As Integer

        iBaseNum = 10



        ' 统计结果

        For i = 0 To MSFlexGridOut.Rows - 1

            For j = 0 To MSFlexGridOut.Cols - 1

                Set xlRange = xlSheet.Range(xlSheet.Cells(i + iBaseNum, j + 1), xlSheet.Cells(i + iBaseNum, j + 1))

                xlRange.Borders(xlEdgeBottom).Weight = 2

                xlRange.Borders(xlEdgeTop).Weight = 2

                xlRange.Borders(xlEdgeLeft).Weight = 2

                xlRange.Borders(xlEdgeRight).Weight = 2

                ' 第一列左对齐

                If j = 0 Then

                    xlRange.HorizontalAlignment = xlLeft       '对齐方式

                End If

                

                ' 标题设置为粗体

                If i = 0 Then

                    xlRange.Font.Bold = True

                    xlRange.HorizontalAlignment = xlCenter       '对齐方式

                End If

            

                If i Mod 2 = 1 Then

                    xlSheet.Cells(i + iBaseNum, j + 1).Interior.ColorIndex = 34  ' 设置隔行颜色，ColorIndex对应的颜色 0~56

                End If

                

                If j > 0 Then

                    xlSheet.Cells(i + iBaseNum, j + 1).ColumnWidth = 12 ' 设置除第一列外的列宽度

                    If MSFlexGridOut.Cols = 6 Then

                        If j = 1 Or j = 2 Then

                            xlSheet.Cells(i + iBaseNum, j + 1).ColumnWidth = 8 ' 设置财务年，财务周、财务月、财务季的列宽度

                        End If

                    End If

                End If

                

                xlSheet.Cells(i + iBaseNum, j + 1) = MSFlexGridOut.TextMatrix(i, j)

            Next j

        Next i





        ' 保存

        xlBook.SaveAs FileName:=mfile, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

              ReadOnlyRecommended:=False, CreateBackup:=False

              

        Set xlSheet = Nothing

    

        xlBook.Close False

        Set xlBook = Nothing

        

        xlApp.Quit              '// 结束Excel对象

        Set xlApp = Nothing     '// 释放xlApp对象

Public ex   As Excel.Application

  Public wb   As Excel.Workbook

  Public sh   As Excel.Worksheet

Private Sub Command1_Click()

  Dim i As Long, A As Long

  Dim arr() As String, str As String

  Dim Path As String

    Set ex = CreateObject("Excel.Application")

    Set wb = ex.Workbooks.Add '新建excel

    Set sh = wb.Sheets(1)   '第一个工作表

    

    str = "A,C,B,D,F"   '你要导入的数据

      

      '导入

      arr = Split(str, ",")

      For i = 0 To UBound(arr)

        sh.Cells(i + 1, 1) = arr(i)

      Next i

       

       Path = "C:\book1.xls"  '保存路径

     

        ActiveWorkbook.SaveAs FileName:=Path, FileFormat:=xlNormal, _

        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

        CreateBackup:=False

    wb.Close SaveChanges:=True    '直接关闭不保存

    ex.Quit

    MsgBox "数据导入完毕-" & "保存在:" & Path, , "提示"

     'ex.Visible = True

    Set ex = Nothing

    Set wb = Nothing

    Set sh = Nothing

End Sub

EXEC master..xp_cmdshell 'bcp "Select * from pubs..jobs" queryout c:\Out.txt -c -SHTSQL02 -Uitsa -Psa1234 ' 

strSQL="INSERT INTO OPENROWSET('Microsoft.Jet.OLEDB.4.0', 

'Excel 8.0;Database=c:\temp\itemmstr.xls;', 

'SELECT select appr_status,BATCH_NO,REF_NO,ITEM_NO,ITEM_DESCE,oms_itemno,ITEM_GRP,MODEL_NO,CUST_PN,REV,DomeSale, MANU_NAME,MANU_PN,PROCUR,SPEC_PROCU,UOM,NET_W,NET_UNIT,CUST_CODE,Safe_Mat,mold_code, material_type,factory_code,item1,item2,item3,item4,item5,item6,item7,item8 ,i_date,by_user,export_fg,  conrohs ,suggest_itemno,batchmgt FROM [Sheet1$]') 

SELECT select appr_status,BATCH_NO,REF_NO,ITEM_NO,ITEM_DESCE,oms_itemno,ITEM_GRP,MODEL_NO,CUST_PN,REV,DomeSale, MANU_NAME,MANU_PN,PROCUR,SPEC_PROCU,UOM,NET_W,NET_UNIT,CUST_CODE,Safe_Mat,mold_code, material_type,factory_code,item1,item2,item3,item4,item5,item6,item7,item8 ,i_date,by_user,export_fg,  conrohs ,suggest_itemno,batchmgt FROM itemmstr where '" & strRefFrom & "'<=REF_NO and REF_NO<='" & strRefTo & "' order by REF_NO "



cn.Execute (strSQL)

补充：VB ,  基础类

上一个：急求助！！新手上路，本人想用vf开发个简单的名片管理系统，出现下面的错误，请高手指教，多谢！
下一个：webbrowser