在VB6中数据存入EXCEL问题

Question

麻烦各位大哥帮帮小弟:
 问题:在VB6中查询时,查询的结果存入指定的EXCEL里,如果原有的数据有的情况下直接更新.
没有的追加.
最好是给我一个参考例子,因为小弟是刚刚接触VB6不久的,小弟先谢谢了.

Answer 1

你可以将excel中的数据像打开一般数据库一样打开。
Dim   db   As   Database   
  Dim   rs   As   Recordset   
  Private   filepath   As   String   
  Private   sheetname   As   String   
    
  Private   Sub   Form_Activate()   
  DoEvents   
  filepath   =   "路径名   &   文件名"   
  sheetname   =   "Sheet1$"   
  Set   db   =   OpenDatabase(filepath,   False,   False,   "Excel   8.0;HDR=yes;")   
  Set   rs   =   db.OpenRecordset(sheetname)   
  rs.MoveFirst   
  Screen.MousePointer   =   11   
  While   rs.EOF   <>   True   
  List1.AddItem   rs.Fields("Name")   &   "     "   &   rs.Fields(1)   &   "     "   &   rs.Fields(2)   
  rs.MoveNext   
  Wend   
  Screen.MousePointer   =   0   
  End   Sub 
这样你想要的操作就简单了哇。

Answer 2

Private Sub Command6_Click()
On Error Resume Next
    Dim xlApp As Excel.Application
    Set xlApp = New Excel.Application
    Set xlApp = CreateObject("Excel.Application")
    'xlApp.Visible = False '隐藏EXCEL应用程序窗口
    Dim strSource, strDestination As String
    strSource = App.Path & "\3.xls"
    'RegisterFee.xls就是一个模版文件
    strDestination = App.Path & "\Temp.xls"
    'FileCopy strSource, strDestination
    Set xlbook = xlApp.Workbooks.Open(strSource)
    '开工作簿，strDestination为一个EXCEL报表文件
    Set Xlsheet = xlbook.Worksheets(1)
    Dim i As Integer
    'MSF.Rows = MSF.Rows - 1
    Xlsheet.Cells(2, 1) = "盘点时间：" & DTPicker1.Value
    For i = 1 To MSF.Rows
        Xlsheet.Cells(i + 4, 1) = MSF.TextMatrix(i, 1)
        Xlsheet.Cells(i + 4, 2) = MSF.TextMatrix(i, 2)
        Xlsheet.Cells(i + 4, 3) = MSF.TextMatrix(i, 3)
        Xlsheet.Cells(i + 4, 4) = MSF.TextMatrix(i, 4)
        Xlsheet.Cells(i + 4, 5) = MSF.TextMatrix(i, 5)
        Xlsheet.Cells(i + 4, 6) = MSF.TextMatrix(i, 6)
        Xlsheet.Cells(i + 4, 7) = MSF.TextMatrix(i, 7)
        Xlsheet.Cells(i + 4, 8) = MSF.TextMatrix(i, 8)
        Xlsheet.Cells(i + 4, 9) = MSF.TextMatrix(i, 9)
        Xlsheet.Cells(i + 4, 10) = MSF.TextMatrix(i, 10)
        Xlsheet.Cells(i + 4, 11) = MSF.TextMatrix(i, 11)
        Xlsheet.Cells(i + 4, 12) = MSF.TextMatrix(i, 12)    Next
    xlApp.Visible = True
End Sub我这里是先把查询出来的显示在MSFLEXGRID里面，然后点这个按钮，通过EXCEL来做打印，把记录集写到EXCEL表里楼主可以参考一下

Answer 3

  本示例在工作表的单元格区域   A1:A500   中查找包含值   2   的所有单元格，并将这些单元格的值更改为   5。   
    
  With   Worksheets(1).Range("a1:a500")   
          Set   c   =   .Find(2,   lookin:=xlValues)   
          If   Not   c   Is   Nothing   Then   
                  firstAddress   =   c.Address   
                  Do   
                          c.Value   =   5   
                          Set   c   =   .FindNext(c)   
                  Loop   While   Not   c   Is   Nothing   And   c.Address   <>   firstAddress   
          End   If   
  End   With   

Answer 4

从SQL中查询在存入到指定的EXCEL中

Answer 5

可是你怎么才能使从SQL中查询的数据存入到指定的EXCEL呢

Answer 6

Private Sub Command1_Click()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    Dim i As Integer
    Dim j As Integer
    
    cn.CursorLocation = adUseClient
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mydb.mdb;Persist Security Info=False"    rs.Open "select * from mytable", cn, adOpenStatic, adLockOptimistic
    
    
    Set xlApp = CreateObject("Excel.Application")   '创建Application对象
    
    strfile = App.Path & "\test3.xls"
    Set xlBook = xlApp.Workbooks.Open(strfile)  '打开文件mstrDataFile付给对象xlBook
    Set xlSheet = xlBook.ActiveSheet   '活动Sheet付值给xlSheet
    
    With xlSheet
        While Not rs.EOF
            i = i + 1
            For j = 0 To rs.Fields.Count - 1
                .Cells(i, j + 1) = rs.Fields(j)
            Next j
            
            rs.MoveNext
        Wend
    End With
    
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
    Set xlSheet = Nothing
    xlBook.Close SaveChanges:=True
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

Answer 7

Private Sub Command1_Click()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    Dim i As Integer
    Dim j As Integer
    
    cn.CursorLocation = adUseClient
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mydb.mdb;Persist Security Info=False"    rs.Open "select * from mytable", cn, adOpenStatic, adLockOptimistic
    
    
    Set xlApp = CreateObject("Excel.Application")   '创建Application对象
    
    strfile = App.Path & "\test3.xls"
    Set xlBook = xlApp.Workbooks.Open(strfile)  '打开文件mstrDataFile付给对象xlBook
    Set xlSheet = xlBook.ActiveSheet   '活动Sheet付值给xlSheet
    
    With xlSheet
        i = 4
        
        While Not rs.EOF
            i = i + 1
'            For j = 0 To rs.Fields.Count - 1
'                .Cells(i, j + 1) = rs.Fields(j)
'            Next j
            .Cells(i, 1) = rs.Fields("SOUKOCD")
            .Cells(i, 2) = rs.Fields("HINCD")
            .Cells(i, 3) = rs.Fields("HINNM")
            .Cells(i, 4) = rs.Fields("HACHUTEN")
            .Cells(i, 5) = rs.Fields("TEKIZAISU")
            
            rs.MoveNext
        Wend
    End With
    
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
    Set xlSheet = Nothing
    xlBook.Close SaveChanges:=True
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

Answer 8

Private Sub cmdOut_Click()
    Dim strSql As String
    Dim OraDyn As Object
   
    
    strSql = " SELECT "
    strSql = strSql & " TJ.SOUKOCD SOUKOCD, "
    strSql = strSql & " TJ.HINCD  HINCD, "
    strSql = strSql & " TD.HINNM HINNM, "
    strSql = strSql & " TJ.HACHUTEN HACHUTEN, "
    strSql = strSql & " TJ.TEKIZAISU TEKIZAISU "
    strSql = strSql & " FROM "
    strSql = strSql & " TMJ0BA TJ, "
    strSql = strSql & " TMD0BA TD "
    strSql = strSql & " WHERE "
    If Check_Null(Me.txtSokoCD.Text) = False Then
        strSql = strSql & " TJ.SOUKOCD = '" & Me.txtSokoCD.Text & "'"
        strSql = strSql & " AND "
    End If
    strSql = strSql & "     TJ.HINCD >='" & Me.txtSakiFrom.Text & "'"
    strSql = strSql & " AND  TJ.HINCD <='" & Me.txtSakiTo.Text & "'"
    strSql = strSql & " AND  TJ.HINCD =TD.HINCD "
    
    
    Set OraDyn = OraDB.CreateDynaset(strSql, ORADYN_READONLY)
    
    
    Dim xlApp   As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlCells As Excel.Range
    Dim strfile As String
    
    Set xlApp = CreateObject("Excel.Application")
    MDBPath = App.Path & "\TempTZZNA.xls"
    Set xlBook = xlApp.Workbooks.Open(MDBPath)
    Set xlSheet = xlBook.ActiveSheet
    With xlSheet
        i = 4
    While Not rs.EOF
            i = i + 1
'            For j = 0 To rs.Fields.Count - 1
'                .Cells(i, j + 1) = rs.Fields(j)
'            Next j
            .Cells(i, 1) = rs.Fields("SOUKOCD")
            .Cells(i, 2) = rs.Fields("HINCD")
            .Cells(i, 3) = rs.Fields("HINNM")
            .Cells(i, 4) = rs.Fields("HACHUTEN")
            .Cells(i, 5) = rs.Fields("TEKIZAISU")
            
            rs.MoveNext
        Wend
    End With
    
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
    Set xlSheet = Nothing
    xlBook.Close SaveChanges:=True
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

Answer 9

Private Sub cmdOut_Click()
    Dim strSql As String
    Dim OraDyn As OraDynaset
    strSql = " SELECT "
    strSql = strSql & " TJ.SOUKOCD SOUKOCD, "
    strSql = strSql & " TJ.HINCD  HINCD, "
    strSql = strSql & " TD.HINNM HINNM, "
    strSql = strSql & " TJ.HACHUTEN HACHUTEN, "
    strSql = strSql & " TJ.TEKIZAISU TEKIZAISU "
    strSql = strSql & " FROM "
    strSql = strSql & " TMJ0BA TJ, "
    strSql = strSql & " TMD0BA TD "
    strSql = strSql & " WHERE "
    If Check_Null(Me.txtSokoCD.Text) = False Then
        strSql = strSql & " TJ.SOUKOCD = '" & Me.txtSokoCD.Text & "'"
        strSql = strSql & " AND "
    End If
    strSql = strSql & "     TJ.HINCD >='" & Me.txtSakiFrom.Text & "'"
    strSql = strSql & " AND  TJ.HINCD <='" & Me.txtSakiTo.Text & "'"
    strSql = strSql & " AND  TJ.HINCD =TD.HINCD "
    Set OraDyn = OraDB.CreateDynaset(strSql, ORADYN_READONLY)
    Dim xlApp   As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlCells As Excel.Range    Set xlApp = CreateObject("Excel.Application")
    MDBPath = App.Path & "\TempTZZNA.xls"
    Set xlBook = xlApp.Workbooks.Open(MDBPath)
    Set xlSheet = xlBook.ActiveSheet
    With xlSheet
        i = 4
    While Not OraDyn.EOF
            i = i + 1
            
            .Cells(i, 1) = OraDyn.Fields("SOUKOCD")
            .Cells(i, 2) = OraDyn.Fields("HINCD")
            .Cells(i, 3) = OraDyn.Fields("HINNM")
            .Cells(i, 4) = OraDyn.Fields("HACHUTEN")
            .Cells(i, 5) = OraDyn.Fields("TEKIZAISU")            OraDyn.MoveNext
            
        Wend
    End With
    Set OraDyn = Nothing    Set xlSheet = Nothing
    xlBook.Close SaveChanges:=True
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = NothingEnd Sub

Answer 10

这都是老问题了,baidu搜搜一大堆