excel无法导入access?

juzhengli2005

excel表格无法导入，都检查了好几偏单元格格式，还是不对。请问是啥原因呢？

juzhengli2005

提示错误：如图

jiahongyu

Public Sub 添加记录并更新()
    Dim mydata As String
    Dim TableExists As Boolean
    Dim myaccess As Access.Application
    Dim myCmd As ADODB.Command
    Dim SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim ws As Worksheet
    Set ws = Sheet1
    mydata = ThisWorkbook.Path & "\学生管理.mdb"
    '判断是否有"学生管理.mdb"文件,如果没有,就创建它
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(mydata) = False Then
        Application.StatusBar = "正在创建数据库......"
        Set myaccess = CreateObject("Access.Application")
        myaccess.NewCurrentDatabase mydata
        myaccess.CloseCurrentDatabase
        Set myaccess = Nothing
    End If
    '建立与数据库"学生管理.mdb"的连接
    Application.StatusBar = "正在建立与数据库的连接......"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    '判断是否有数据表"学生信息",如果没有.就创建它
    TableExists = False
    Set rs = cnn.OpenSchema(adSchemaTables)
    Do Until rs.EOF
        Application.StatusBar = "正在检查数据表......"
        If LCase(rs!table_name) = LCase("学生信息") Then
            TableExists = True
            Exit Do
        End If
        rs.MoveNext
    Loop
    If TableExists = False Then
        Application.StatusBar = "正在创建数据表......"
        Set myCmd = New ADODB.Command
        Set myCmd.ActiveConnection = cnn
        myCmd.CommandText = "create table 学生信息 (学号 text(10),姓名 text(4)," _
            & "性别 text(1),系别 text(20),班级 text(10),面貌 text(2)," _
            & "出生日期 date,籍贯 text(10))"
        myCmd.Execute , , adCmdText
        Set myCmd = Nothing
    End If
    '删除数据表中原有的全部记录
    Application.StatusBar = "正在删除原有的全部记录......"
    SQL = "delete from 学生信息"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '向数据表中添加新记录
    SQL = "select * from 学生信息"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    For i = 2 To ws.Range("A65536").End(xlUp).Row
    Application.StatusBar = "正在向数据库添加学生信息记录......"
        rs.AddNew
        rs.Fields("学号") = ws.Cells(i, 1)
        rs.Fields("姓名") = ws.Cells(i, 2)
        rs.Fields("性别") = ws.Cells(i, 3)
        rs.Fields("系别") = ws.Cells(i, 4)
        rs.Fields("班级") = ws.Cells(i, 5)
        rs.Fields("面貌") = ws.Cells(i, 6)
        rs.Fields("出生日期") = ws.Cells(i, 7)
        rs.Fields("籍贯") = ws.Cells(i, 8)
        rs.Update
    Next i
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Application.StatusBar = False
End Sub



***********************************重新修改后***********
Sub 添加记录并更新()
Dim cnn As New ADODB.Connection
Dim strPath As String
Dim rw As Range
Dim strSQL As String
Dim R As Long

R = [A65536].End(xlUp).Row
If R < 2 Then
    MsgBox "没有数据要更新！"
    Exit Sub
End If
strPath = ThisWorkbook.Path & "\学生管理.mdb"
cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & strPath

For Each rw In Range("A2:A" & R).EntireRow.Rows
    strSQL = "UPDATE 学生信息 SET [姓名]='" & rw.Cells(2) & "', [性别]='" & rw.Cells(3) & "', [系别]='" _
            & rw.Cells(4) & "', [班级]='" & rw.Cells(5) & "', [面貌]='" & rw.Cells(6) & "', [出生日期]=#" _
            & rw.Cells(7) & "#, [籍贯]='" & rw.Cells(8) & "' where [学号]='" & rw.Cells(1) & "'"
    cnn.Execute (strSQL)
    strSQL = ""
Next rw
Set cnn = Nothing

End Sub

wenjun4

好复杂啊

zzqljc

看不懂哦

jiahongyu

最好上传实例，让大家来帮你修改？

ACMAIN_CHM

上传一个测试用的EXCEL文件，从错误信息上看，是你的EXCEL的表头中有无法做为字段名的列存在。

szyewj

从错误信息上看，是你的EXCEL的表头中有无法做为字段名的列存在