紧急求助：excel转word

[usavoa1]

问题是这样的：
有张excel表，内容如下：
Id Name Price compId
1 a 1 c001
2 b 2 c002
3 c 3 c001
4 d 4 c002

我想在VB里实现以下功能：
将上面的excel表按照compId 分类，分别导出到word中。如，上面的excel生成了两个word文件，分别是

word1.doc：
Id Name Price compId
1 a 1 c001
3 c 3 c001

word2.doc：
Id Name Price compId
2 a 2 c002
4 c 4 c002


该功能在vb或者vb.net中如何实现呢？望高人指点！！！

[tjficcbw]

打开EXCEL存储WORK

[tjficcbw]

   Private Sub Botton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        xlsName = My.Application.Info.DirectoryPath & "\temp.xls"

        '用 Add方法 创建新的工作簿和工作表对象。
        xlApp = New Microsoft.Office.Interop.Excel.Application
        xlBook = xlApp.Workbooks.Open(xlsName)
        'Set xlBook = xlApp.Workbooks.Add
        xlSheet = xlBook.Worksheets("work")
        xlSheet.Name = "work"
        '   If Err.Number = 1004 Then
        '      xlSheet.Name = formatdatetime(DateTimePicker1, "yyyymm")
        '      MsgBox (DateTimePicker1 & "工作表已存在将自动产生sheel系列工作表")
        '      Err.Number = 0
        '   End If


        '将data3的值赋给Microsoft Excel 单元。
        'sqlString = "select * from worktable"
        'If Conn.State = 1 Then
        '    If Rs.State = 1 Then Rs.Close()
        '    Rs.Open(sqlString, Conn, 1, 1)
        'Else
        '    Conn.Open(conString)
        '    Rs.Open(sqlString, Conn, 1, 1)
        'End If


        For i = 0 To 5
            For j = 0 To 7
                xlSheet.Cells._Default(i + 1, j + 1).Value = i & "," & j
            Next j
        Next i
        'xlSheet.Cells(3, 1).Formula = "=R1C1 + R2C1"
        '保存工作表
        'xlSheet.StandardWidth = 2
        'xlSheet.SaveAs (App.path & "\" & formatdatetime(DateTimePicker1, "yyyy年mm月值班表") & formatdatetime(Now(), "hhmmss") & ".xls")
        xlBook.Save()
        xlBook.Close()

        '用 Quit 方法关闭 Microsoft Excel
        xlApp.Quit()

        '释放对象
        Dim pro As Process
        For Each pro In Process.GetProcesses
            If pro.ProcessName = "EXCEL" Then
                pro.Kill()
            End If
        Next

    End Sub

[水如烟]

简单代码

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim table As New DataTable

        table.Columns.Add("ID").AutoIncrement = True
        table.Columns.Add("Name")
        table.Columns.Add("Count", GetType(Integer))

        With table.Rows
            .Add(New Object() {Nothing, "xiao", 1000})
            .Add(New Object() {Nothing, Nothing, Nothing})
            .Add(New Object() {Nothing, "wang", DBNull.Value})
            .Add(New Object() {Nothing, DBNull.Value, 1})
        End With

        table.AcceptChanges()


        Dim doc As New WordDoc
        doc.CreateDocument("c:\c.doc")
        doc.ImportTable("全部", table.DefaultView)

        doc.ImportTable("ID<=2", New DataView(table, "ID<=2", Nothing, DataViewRowState.CurrentRows))

        doc.ImportTable("ID>2", New DataView(table, "ID>2", Nothing, DataViewRowState.CurrentRows))

        doc.Close()
    End Sub

Option Strict Off

Public Class WordDoc
    Private App As Object
    Private Document As Object
    Private Selection As Object

    Private Const wdSaveChanges As Integer = -1
    Private Const wdStory As Integer = 6

    Public Sub CreateDocument(ByVal file As String)

        If App Is Nothing Then
            App = CreateObject("Word.Application")
        End If

        Document = App.Documents.Add
        Document.SaveAs(file) '小心。如已存在，则会删了重建一个 
        Selection = Document.ActiveWindow.Selection
    End Sub

    Public Sub ImportTable(ByVal title As String, ByVal dv As DataView)
        If App Is Nothing Then Return
        If dv Is Nothing Then Return

        Selection.EndKey(Unit:=wdStory) '到最后一行
        Selection.TypeParagraph() '回车
        Selection.TypeText(Text:=title)
        Selection.TypeParagraph() '回车

        Dim rowCount As Integer = dv.Count + 1 '包括表头
        Dim colCount As Integer = dv.Table.Columns.Count

        Dim currentRange As Object = Selection.Range
        Dim docTable As Object = Document.Tables.Add(Range:=currentRange, NumRows:=rowCount, NumColumns:=colCount)
        docTable.Style = "网格型"

        '表头名称
        For colIndex As Integer = 1 To colCount
            docTable.Cell(1, colIndex).Range.Text = dv.Table.Columns(colIndex - 1).ColumnName
        Next
        '行内容
        For rowIndex As Integer = 2 To rowCount
            For colIndex As Integer = 1 To colCount
                docTable.Cell(rowIndex, colIndex).Range.Text = dv.Item(rowIndex - 2)(colIndex - 1).ToString
            Next
        Next

    End Sub

    Public Sub Close()
        If App IsNot Nothing Then
            App.Quit(wdSaveChanges)
            App = Nothing
            Document = Nothing
            Selection = Nothing
        End If

    End Sub

End Class

[水如烟]

具体到你的excel

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim ExcelConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties=""Excel 8.0;HDR=Yes;ReadOnly=0;"""

        Dim cn As New OleDb.OleDbConnection(String.Format(ExcelConnectionString, "c:\book1.xls"))
        Dim ad As New OleDb.OleDbDataAdapter("SELECT * FROM [Sheet1$]", cn)

        Dim table As New DataTable
        ad.Fill(table)

        Dim compIDArray As New List(Of String)
        Dim compID As String
        For Each row As DataRow In table.Rows
            compID = row("CompID")
            If compIDArray.Contains(compID) Then Continue For
            compIDArray.Add(compID)
        Next

        Dim doc As New WordDoc

        For Each compID In compIDArray
            doc.CreateDocument(String.Format("c:\{0}.doc", compID))
            doc.ImportTable(compID, New DataView(table, String.Format("compID  = '{0}'", compID), Nothing, DataViewRowState.CurrentRows))

        Next

        doc.Close()
    End Sub

以上不考虑效率.仅供参考.

[floadcloud]

没弄过,帮你顶

[usavoa1]

有人回答我吗？分不够再加啊

[bw555]

把excel作为数据源，写查询语句，
把数据导入到datatable中，
然后对数据做判断
如果为c001写入到word1，c002写入到word2
大体思路就是这样

[usavoa1]

还有人回答吗