VB如何访问EXCEL文件

Question

VB如何访问EXCEL文件，用ODBC可以吗？

Answer 1

用excel.application对象。
工程/引用里添加excel库。

Answer 2

Option Explicit'Private xlApp As Excel.Application
'Private xlBook As Excel.Workbook
'Private xlSheet As Excel.Worksheet
Private xlApp As Object
Private xlBook As Object
Private xlSheet As ObjectPrivate cellValue As StringPublic strError As String
Public ExportOK As Boolean
Private Sub Class_Initialize()
    ExportOK = False
    On Error GoTo errHandle:
'    Set xlApp = CreateObject("Excel.Applaction")
    Set xlApp = New Excel.Application
    xlApp.Visible = False
    On Error GoTo errHandle:
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    If Val(xlApp.Application.Version) >= 8 Then
        Set xlSheet = xlApp.ActiveSheet
    Else
        Set xlSheet = xlApp
    End If
    Exit Sub
errHandle:
    Err.Raise 100001, , "建立Excel对象时发生错误:" & Err.Description & vbCr & _
        "请确保您正确了安装了Excel软件!"
End SubPublic Property Get TextMatrix(Row As Integer, Col As Integer) As Variant
    TextMatrix = xlSheet.Cells(Row, Col)
End Property
Public Property Let TextMatrix(Row As Integer, Col As Integer, Value As Variant)
    xlSheet.Cells(Row, Col) = Value
End Property'合并单元格
Public Sub MergeCell(bRow As Integer, bCol As Integer, eRow As Integer, eCol As Integer)
    xlSheet.Range(GetExcelCell(bRow, bCol) & ":" & GetExcelCell(eRow, eCol)).Select
    With xlApp.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
End Sub
'打印预览
Public Function PrintPreview() As Boolean
    On Error GoTo errHandle:
    xlApp.Visible = True
    xlBook.PrintPreview True
    Exit Function
errHandle:
    If Err.Number = 1004 Then
        MsgBox "尚未安装打印机,不能预览!", vbOKOnly + vbCritical, "错误"
    End If
End Function
'导出
Public Function ExportExcel() As Boolean
    xlApp.Visible = True
End Function
'画线
Public Sub DrawLine(bRow As Integer, bCol As Integer, eRow As Integer, eCol As Integer)
On Error Resume Next
    xlSheet.Range(GetExcelCell(bRow, bCol) & ":" & GetExcelCell(eRow, eCol)).Select
    xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With xlApp.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
'导出记录集到Excel
Public Sub RstExport(Rst As ADODB.Recordset, bRow As Integer, bCol As Integer, GridHead() As String)
    Dim i As Integer, j As Integer
    For i = bCol To UBound(GridHead) + bCol
        With Me
            .TextMatrix(bRow, i) = GridHead(i - bCol)
        End With
    Next
    i = 1 + bRow
    Do While Not Rst.EOF
        For j = 1 To Rst.Fields.Count
            If Rst.Fields(j - 1).Type = adChar Or Rst.Fields(j - 1).Type = adVarChar Then
                xlSheet.Range(GetExcelCell(i, j) & ":" & GetExcelCell(i, j)).Select
                xlApp.Selection.NumberFormatLocal = "@"         '已文本方式格式化
            End If
            Me.TextMatrix(i, j) = checkNull(Rst.Fields(j - 1).Value)
        Next
        i = i + 1
        Rst.MoveNext
    Loop
End Sub'或者指定行,列号的Excel编码
Private Function GetExcelCell(Row As Integer, Col As Integer) As String
    Dim nTmp1 As Integer
    Dim nTmp2 As Integer
    Dim sTmp As String
    If Col <= 26 Then
        sTmp = Chr(Asc("A") + Col - 1)
    Else
        nTmp1 = Col \ 26
        If nTmp1 > 26 Then
            Err.Raise 100000, , "列数过大,发生错误"
            Exit Function
        Else
           sTmp = Chr(Asc("A") + nTmp1 - 1)
           nTmp1 = Col Mod 26
           sTmp = sTmp & Chr(Asc("A") + nTmp1 - 1)
        End If
    End If
    GetExcelCell = sTmp & Row
End Function
'将Null返回为空串
Private Function checkNull(s As Variant) As String
    checkNull = IIf(IsNull(s), "", s)
End FunctionPrivate Sub Class_Terminate()
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
End Sub
在引用里面引用"Microsoft EXCEL Object 9.0"类库....然后你可以试试我的这个类.

Answer 3

ExpFNum = FreeFile
    Open ExpFName For Output As #ExpFNum
 
    For ii = 0 To ResultGrid.Rows - 1
        WriteLine = Trim$(ResultGrid.TextMatrix(ii, 0)) 
        For jj = 2 To ResultGrid.Cols - 1
            TmpStr = ResultGrid.TextMatrix(ii, jj)            
            WriteLine = WriteLine & "," & Trim$(TmpStr)
        Next jj
        Print #ExpFNum, WriteLine
    Next ii

Answer 4

类似的问题请访问：
http://community.csdn.net/Expert/TopicView.asp?id=3700562