VB程序员博客

就是把Excel的数据导入到Access数据库中，代码如下：

Private Sub cmdInput_Click()
CommonDialog1.CancelError = True
On Error GoTo Err:
CommonDialog1.Filter = "(*.xls)|*.xls"
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
Dim excelPath As String
excelPath = CommonDialog1.FileName
Err:
If Err.Number <> 0 Then
Exit Sub
End If
Dim Msg, Style, Title, Response
Msg = "导入新数据前将清空原有数据（不可恢复），您确定要导入吗？"
Style = vbYesNo + vbExclamation + vbDefaultButton2
Title = "提醒"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "dbemp.mdb;" & "Persist Security Info=False"
conn.Open
Dim tableName As String
tableName = "Emptable"
Set rs = conn.OpenSchema(adSchemaTables, Array(Empty, Empty, tableName, "Table"))
If Not rs.EOF Then
conn.Execute "Drop Table [Emptable]"
End If
Dim db As Database
Dim sheet As String
Dim accessPath As String
Dim accessTable As String
Dim SQL As String
accessPath = App.Path & "dbemp.mdb"
accessTable = "Emptable"
sheet = "sheet1"
Set db = OpenDatabase(excelPath, True, False, "Excel 8.0")
SQL = ("Select * into [;database=" & accessPath & "]." & accessTable & " from [" & sheet & "$]")
db.Execute (SQL)
rs.Close
conn.Close

现在有个很奇怪的问题，如果Excel的每个单元格中的数据都是字母或者都是数字的话，那么可以正常导入，而那些数据中如果既有字母也有数字的话，那么那些纯为数字的单元格中的数据将无法导入，这是怎么回事呀，而且就算事先把所有单元格格式设定为“文本”类型，那些数字还是无法导入，郁闷！

补充一点：如果表中已有数据的情况，把单元格格式设定为“文本”类型，那也是无法导入的；但如果是设定“文本”类型以后，再向单元格中输入数字，那这些数字可被导入！现在有个很奇怪的问题，如果Excel的每个单元格中的数据都是字母或者都是数字的话，那么可以正常导入，而那些数据中如果既有字母也有数字的话，那么那些纯为数字的单元格中的数据将无法导入，这是怎么回事呀，而且就算事先把所有单元格格式设定为“文本”类型，那些数字还是无法导入，郁闷！

看了一下你代码,只是想说ado的方式操作excel不是很稳定,一般来说 可以用 加一个

空格的方式，是ado不把这行当成数字格式的。。。不过这个我记不清楚了，如果不成功的话

我研究一下

保底的方式是vba 但是从难易度 和  效率来看都不好。。。http://www.cnblogs.com/frostcity/archive/2008/03/07/1095484.html

这个方案也可以考虑，文本数字的混合型输入本身就不太好解决<
<
<
有这种事,我想不是ado不稳定,还是数据格式问题,Excel2003将数字作为字符处理比较怪,左上角有个黄色的小三角<
<
主要是先输入还是先设格式的问题，呵呵

导入Excel时，在Access数据表中不管是“在原有数据上追加数据”，还是“把原有数据清零后再添加数据”，小弟都很想要啊，前辈们有没有这方面的好东西啊详细点，可以吗？http://topic.csdn.net/t/20050528/10/4041671.html比如说，程序界面上有个“导入”按钮，后台有个Access数据库，里面有个表叫“a表”

我能不能点击“导入”按钮，然后在硬盘上选择一个Excel文件，就可以把这个Excel文件里的记录全部导入到Access数据库里的“a表”中

导入方式可能有两种：
一种是先将“a表”中的记录清空后，再把Excel中的记录写到“a表”中
另一种是“a表”中的原有记录还在，然后把Excel中的记录追加进“a表”

只要能得到源码，导入方式是哪一种，小弟无所谓呀链接上一大堆的源代码呢,你照着抄好了…<

忘了告诉你 conn.Execute "Drop table [Emptable]" 需要注释了
如还有问题在联系<
<

小弟不会vba编程，不得已而用之，请勿见笑。
要求是在access里编一段vba程序，功能如下：
1.遍历某文件夹下的所有excel文件。
2.将读取到的excel文件导入access（每次一个）。
3.再将该access文件导入到sqlserver（每次一个）。
第一步比较简单，请教下大家2、3步该怎么做~谢谢

大家别认为我这么导来导去的吃多了。。。实在时excel在导入sqlserver时，如果表中某列既有数字又有字符时，进到sqlserver全是NULL。。经多次试验发现只能先导到access再进sqlserver才可以:(  不知道微软咋搞得

我做了一个vb MSHFlexGrid1表中的数据导入到EXCEL中，导出后显示在Excel单元格中，由于字段过长而导致显示不完全，有没有办法解决这个问题？

请高手帮忙！

Columns("B:B").ColumnWidth = 28.63

没注意是自动

Columns("B:B").EntireColumn.AutoFit

Sub daoyu()
      Dim row As Integer
      Dim colm As Integer
      Dim sheet1 As Object
      Dim excel_app As Object
                Dim xlsbook  As New Excel.Workbook
          DoEvents
          Set excel_app = CreateObject("excel.application")
          excel_app.Workbooks.Open (CommonDialog1.FileName)
          Set sheet1 = excel_app.Workbooks(1).Worksheets("sheet1")
          ret.CursorLocation = adUseClient
   
          ret.Open sql, conn, adOpenKeyset, adLockPessimistic
         
          fieldsnu = ret.Fields.Count
          conn.BeginTrans
          row = 2
          'Do    'While (Len(Trim$(Sheet.Cells(row, 1))) > 0)
          If Len(Trim(Sheet.Cells(row, 1))) = 0 Then
         
          MsgBox "没有数据！", vbOKOnly + vbExclamation, "温馨提示"
          ret.AddNew
          For colm = 0 To fieldsnu - 1
          ret.Fields(colm).Value = Trim(sheet1.Cells(row, colm + 1).Value)
          Next colm
          ret.Update
          row = row + 1
         
         
          ret.Close
          Set ret = Nothing
          MsgBox "导入数据成功！", vbOKOnly + vbExclamation, "温馨提示"
          conn.CommitTrans
          excel_app.ActiveWorkbook.Close
          excel_app.Application.Quit
          excel_app.Quit
          Set sheet1 = Nothing
          Set excel_app = Nothing
          conn.Close
          Set conn = Nothing
         
          End If
        End Sub

    Private Sub Command1_Click()
    sql = "select  *  from  collegedepart"
          Call daoyu

End Sub
运行的时候没有响应，急求帮助！！！
在做毕业论文，快要交了，很急呀

ret =ADODB.Recordset ？

有一个txt文件，有12列，若干行，是从其他地方拷贝过来的数据，行数不确定，每个数据中间是用 tab 分隔的。

vb5 + windows xp 无法使用 split 函数

command1 + msflexgrid1（没有进行任何设置）

现在想要实现的第一个目标是：

点击 command1 之后，从 app.path 的 test.txt 中把数据读到 msflexgrid1 中，msflexgrid1 的行数需要根据 txt 的行数动态添加。

请问：这个目标有办法实现吗？谢了先！

请问：我现在想在第一列填入id号，并让第一列不允许编辑（已添加text）。

能否把第一列整个空出来，从第二列开始读入数据？

还有，怎么让第一列不被编辑？

datagrid 中数据是绑定的，最好给个例子，谢谢

僅供參考:

Public Function TDGExportOld( _
                        ByVal objDBGrid As TrueOleDBGrid70.TDBGrid _
                            )
    Dim objExcel As Excel.Application
    Dim objWorkBook As Excel.Workbook
    Dim objSheet As Excel.Worksheet

   
    Dim a As Integer, b As Integer
    Dim rs As ADODB.Recordset, rsClone As ADODB.Recordset
    Dim intColumnsCount As Integer, AryDataField() As String
    Dim strBadInfo As String
    On Error GoTo ErrHandle:
    Dim I As Integer
   
    ShowWait "戈旧い,叫祔……"
    Set rs = objDBGrid.DataSource
    If rs Is Nothing Then GoTo NoRecord
    If rs.State = adStateClosed Then GoTo NoRecord
    If rs.RecordCount = 0 Then GoTo NoRecord
    Set rsClone = rs.Clone
    rsClone.filter = rs.filter
    intColumnsCount = objDBGrid.Columns.Count
    ReDim AryDataField(0 To intColumnsCount)

    Set objExcel = New Excel.Application
    Set objWorkBook = objExcel.Workbooks.Add
    Set objSheet = objWorkBook.Worksheets.Add
    a = 1
    With objSheet
        b = 1
        For I = 0 To intColumnsCount - 1
            If objDBGrid.Columns(I).Visible = True Then
                    .Cells(a, b) = objDBGrid.Columns(I).Caption
                    AryDataField(b) = objDBGrid.Columns(I).DataField
                    b = b + 1
              End If
        Next
        intColumnsCount = b - 1
        ReDim Preserve AryDataField(0 To intColumnsCount)
        a = a + 1
           
           
        While Not rsClone.EOF
            ShowWait "タ旧材" & rsClone.AbsolutePosition & "/" & rsClone.RecordCount & ",叫祔……"
            For b = 1 To intColumnsCount
                .Cells(a, b) = ReadStrFromRs(rsClone, AryDataField(b))
            Next b
              a = a + 1
              rsClone.MoveNext
        Wend
       
    End With
    objExcel.Visible = True
    GoTo ExitFunction
   
ErrHandle:
  ShowError
  GoTo ExitFunction
 
NoRecord:
    strBadInfo = "礚祇瞷旧戈"
    GoTo ExitFunction
   
ExitFunction:
    ShowWait ""
   
    If Not rsClone Is Nothing Then
      If rsClone.State = adStateOpen Then rsClone.Close
      Set rsClone = Nothing
    End If
    Set objSheet = Nothing
    Set objWorkBook = Nothing
    Set objExcel = Nothing
    If strBadInfo <> "" Then
        MsgBox strBadInfo, vbInformation, g_strTitle
    End If
End Function

赞同 一楼方法

Dim i As Integer, r As Integer, c As Integer
  Dim newxls As New Excel.Application
  Dim newbook As New Excel.Workbook
  Dim newsheet As New Excel.Worksheet
  Set newbook = newxls.Workbooks.Add  '创建工作簿
  Set newsheet = newbook.Worksheets(1) '创建工作表
  If Sql <> "" Then
    Adodc1.RecordSource = Sql
    Adodc1.Refresh
  End If
  If Adodc1.Recordset.RecordCount > 0 Then
    For i = 0 To DataGrid1.Columns.Count - 1
        newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption '指定表头名称
    Next i
    '指定表格内容
    Adodc1.Recordset.MoveFirst
    Do Until Adodc1.Recordset.EOF
        r = Adodc1.Recordset.AbsolutePosition
        For c = 0 To DataGrid1.Columns.Count - 1
            DataGrid1.Col = c
            newsheet.Cells(r + 1, c + 1) = DataGrid1.Columns(c)
        Next c
        Adodc1.Recordset.MoveNext
    Loop
     
    Dim myval As Long
    Dim mystr As String
    myval = MsgBox("是否保存该Excel表?", vbYesNo, "提示窗口")
    If myval = vbYes Then
      mystr = InputBox("请输入文件名称", "输入窗口")
       
      If Len(mystr) = 0 Then
        MsgBox "系统不允许文件名称为空！", , "提示窗口"
        Exit Sub
      End If
      On Error GoTo ErrSave
      newsheet.SaveAs App.Path  & mystr & ".xls"
      Adodc1.Recordset.MoveFirst
            MsgBox "Excel文件保存成功，位置：" & App.Path  & mystr & ".xls", , "提示窗口"

      newxls.Quit
ErrSave:
      Exit Sub
      MsgBox Err.Description, , "提示窗口"
     
      Else: Adodc1.Recordset.MoveFirst
    End If
 
  End If

怎么用到了Adodc1啊，请解释下

Adodc 和 DataGrid 绑定

不过我的datagrid 是通过一条SQL语句绑定的啊，没有通过Adodc绑定

将
Adodc1.Recordset

全部改为

Rs (你的记录集就行了)

学习学习！

感谢　楼上各位兄弟，问题搞定，

如何做一个Access导入Excel数据一样的向导？
特别是先选择文件后，就能看到excel表的内容，特别是选择工作薄标签后，就刷新内容

自己顶一下

这个很容易做的

当我把从DataGrid中显示出来的数据导入到EXCEL中，但是导到EXCEL时的时间字段值全都是一些乱七八糟的数字，我数据库的时间字段都是smalldatetime类型，请问我怎么做才能使导入到EXCEL中的时间字段值能正确显示。以下是我从DataGrid中显示出来的数据导入到EXCEL的代码。
  Set xlapp = CreateObject("excel.application")
Set xlBook = xlapp.Workbooks.Add
Set xlSHEET = xlBook.Worksheets(1)
xlapp.Visible = True '设置EXCEL可见
On Error Resume Next
If Err.Number <> 0 Then Set xlapp = CreateObject("Excel.Application")
Set xlBook = xlapp.Workbooks.Add
Set xlSHEET = xlBook.ActiveSheet
For k = 1 To DataGrid1.Columns.Count
xlSHEET.Cells(1, k) = DataGrid1.Columns(k - 1).Caption
Next k
For i = 1 To Adodc1.Recordset.RecordCount + 1
For j = 0 To DataGrid1.Columns.Count
xlSHEET.Cells(i + 1, j + 1) = Adodc1.Recordset(j) '
Next j
Adodc1.Recordset.MoveNext

Next i

Private Sub Command1_Click()
      Set xlapp = CreateObject("excel.application")
    Set xlBook = xlapp.Workbooks.Add
    Set xlSHEET = xlBook.Worksheets(1)
    xlapp.Visible = True '设置EXCEL可见
    On Error Resume Next
    If Err.Number <> 0 Then Set xlapp = CreateObject("Excel.Application")
    Set xlBook = xlapp.Workbooks.Add
    Set xlSHEET = xlBook.ActiveSheet
    For k = 1 To DataGrid1.Columns.Count
    xlSHEET.Cells(1, k) = DataGrid1.Columns(k - 1).Caption
    Next k
    xlSHEET.Range("c2", "c20").NumberFormatLocal = "yyyy-m-d"    For i = 1 To Adodc1.Recordset.RecordCount + 1
    For J = 0 To DataGrid1.Columns.Count
'        If Adodc1.Recordset(J).Type = adDate Then
'        End If
           
        xlSHEET.Cells(i + 1, J + 1) = Adodc1.Recordset(J) '
    Next J
    Adodc1.Recordset.MoveNext

Next i
End Sub

Private Sub Command1_Click()
      Set xlapp = CreateObject("excel.application")
    Set xlBook = xlapp.Workbooks.Add
    Set xlSHEET = xlBook.Worksheets(1)
    xlapp.Visible = True '设置EXCEL可见
    On Error Resume Next
    If Err.Number <> 0 Then Set xlapp = CreateObject("Excel.Application")
    Set xlBook = xlapp.Workbooks.Add
    Set xlSHEET = xlBook.ActiveSheet
    For k = 1 To DataGrid1.Columns.Count
    xlSHEET.Cells(1, k) = DataGrid1.Columns(k - 1).Caption
    Next k
    xlSHEET.Range("c2", "c20").NumberFormatLocal = "yyyy-m-d"
    For i = 1 To Adodc1.Recordset.RecordCount + 1
    For J = 0 To DataGrid1.Columns.Count
'        If Adodc1.Recordset(J).Type = adDate Then
'        End If
           
        xlSHEET.Cells(i + 1, J + 1) = Adodc1.Recordset(J) '
    Next J
    Adodc1.Recordset.MoveNext

Next i
End Sub

你这好像不是VB语言吧？我有人能把我的代码修改一下

加
xlSHEET.Range("c2", "c20").NumberFormatLocal = "yyyy-m-d"
就可以了

我加上了这句还是没有效果  请问那加上的那句是什么意思？请详细的解释一下，谢谢！！！再谢！！！

苦等！！！

转换成字符串

我试验时c列是日期，你的是哪一列改一下

我想问你，这个("c2", "c20")是什么意思啊 ？我的导入到EXCEL的时间列是F列，我把他改为xlSHEET.Range("f2", "f20").NumberFormatLocal = "yyyy-m-d" 后只有想2008-9-4像这样的月，天是一位数的才能显示，像2008-8-24这样的就是显示不出来了，后来我改为"yyyy-m-dd"全都显示不出来了。请你帮我修改一下既能显示2008-11-24，也能显示2008-8-12，还能显示2008-9-4这三种不同格式

("c2", "c20")
是c列2到20行

"yyyy-mm-dd"

我现在弄懂了你的（"c2", "c20")代表什么意思，"c2"代表时间转换列的起始行，"c20"代表时间转换列的终止行  但NumberFormatLocal = "yyyy-m-d  却只能转换日期像：2008-9-4这样的格式，像2008-11-4，2008-8-23 2008-11-14都不能转换

Private   Sub   Form_Load()
On   Error   GoTo   err

With   CommonDialog1
.FileName   =   "*.xls "
.Filter   =   "(Excel)*.xls|*.xls "
.CancelError   =   True
.ShowOpen
End   With
excelPath   =   CommonDialog1.FileName
Dim   cn   As   New   ADODB.Connection
Dim   rs   As   New   Recordset
cn.ConnectionString   =   "Provider=SQLOLEDB.1;Integrated   Security=SSPI;Persist   Security   Info=False;Initial   Catalog=sales "
cn.Open
cn.Execute   "select   *   into   invest1   from   OpenRowSet( 'microsoft.jet.oledb.4.0 ', 'Excel   8.0;HDR=Yes;database=CommonDialog1.FileName; ', 'select   *   from   [Sheet1$] ') "
'此处如果使用具体的路径则导入成功，若不是则报错“OLE   DB提供程序，想请教！‘ 'microsoft.jet.oledb.4.0 '’报错”
cn.Close
Set   cn   =   Nothing
Adodc1.ConnectionString   =   "Provider=SQLOLEDB.1;Integrated   Security=SSPI;Persist   Security   Info=False;Initial   Catalog=sales "
Exit   Sub
err:
MsgBox   err.Description

End   Sub
出现这样的错误
[OLE/DB   provider   returned   message:找不到可安装的   ISAM.]

都是很好的建议! 值得学习