| 网站首页 | 业界新闻 | 小组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 1101 人关注过本帖
标题:电子表格导入到ACCESS后关不了,各种方法都试过,附原程序
只看楼主 加入收藏
natesc
Rank: 1
等 级:新手上路
帖 子:40
专家分:0
注 册:2013-9-15
结帖率:37.5%
收藏
已结贴  问题点数:20 回复次数:9 
电子表格导入到ACCESS后关不了,各种方法都试过,附原程序
附件: 游客没有浏览附件的权限,请 登录注册
搜索更多相关主题的帖子: 电子 
2017-03-30 21:24
ZHRXJR
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:116
帖 子:997
专家分:5322
注 册:2016-5-10
收藏
得分:10 
回复 楼主 natesc
哎,怎么说呢?一个非常简单的问题,你搞的太复杂了,Excel(还是2003版本)导入到Access,非常简单的。
你的代码我没有仔细看,导入到2003的Access二步就完成了,读出数据,存储到Access中,总代码要不了100行。字段仅仅9个,太简单了。
联系我,给你代码。

请不要选我做版主
2017-03-30 22:23
natesc
Rank: 1
等 级:新手上路
帖 子:40
专家分:0
注 册:2013-9-15
收藏
得分:0 
回复 2楼 ZHRXJR
我怕新代码在整个软件中不能使用,这个附件是整个软件中分割出来的。最好在我的原代码中修改
2017-03-31 09:19
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
收藏
得分:10 
经调试,可能你再获取数据时对excel表格进行了修改,所以退出时会提示是否保存,但又没有显示提示,从外观上看就是excel未退出,command7_click代码修改如下应该没问题(红色部分为修改部分):

Private Sub Command7_Click() '题库导入

    On Error GoTo err1
   
   
    Dim ZJStr() As String '章节列表
    Dim ZJId() As String
   
    Dim FileStr As String
    CommonDialog1.FileName = ""
    CommonDialog1.Filter = "Excel表格文件|*.xls"
    CommonDialog1.Action = 1
   
    FileStr = CommonDialog1.FileName
   
    If FileStr = "" Then
        Exit Sub
    End If
   
   
    Label1.Caption = "正在分析章节信息,请稍后!"
   
    Dim Sql As String
    Dim MsgTxt As String
    Dim Rs_Zj As ADODB.Recordset
    Dim Rs As ADODB.Recordset
   
   
    Sql = "select * from zjinfo "
    Set Rs_Zj = ExecuteSQL(Sql, MsgTxt)
   
    If InStr(MsgTxt, "错误") Then
        MsgBox MsgTxt
        Exit Sub
    End If
   
    ReDim ZJStr(0)
    ReDim ZJId(0)
    If Rs_Zj.RecordCount > 0 Then '========================获取章节信息 如果有
   
        For i = 1 To Rs_Zj.RecordCount
            ReDim Preserve ZJStr(i)
            ReDim Preserve ZJId(i)
            
            ZJStr(i) = Rs_Zj.Fields("zjname") & ""
            ZJId(i) = Rs_Zj.Fields("zjid") & ""
            Rs_Zj.MoveNext
        Next i
        
        
    End If
   
   
    Sql = "select * from tminfo"
    Set Rs = ExecuteSQL(Sql, MsgTxt)
    If InStr(MsgTxt, "错误") Then
        MsgBox MsgTxt
        Exit Sub
    End If
   
   
   
    Dim NewApp As Excel.Application
    Dim NewSheet As Excel.Worksheet
    Dim NewBook As Excel.Workbook
   
    Set NewApp = New Excel.Application
    Set NewBook = NewApp.Workbooks.Open(FileStr, , , , "")
    '第一位为路径,第五位为密码
    Set NewSheet = NewBook.Worksheets(1)
    'NewApp.Visible = True
    For i = 2 To NewSheet.Cells.Count
        
        Label1.Caption = "正在读取第" & i & 项
        DoEvents
        If Trim(NewSheet.Cells(i, 1)) = "" Then
            Exit For
        End If
        
        '先判断该章节是否已经添加
        
        For j = 1 To UBound(ZJId)
            
            If ZJStr(j) = Trim(NewSheet.Cells(i, 8)) Then
                Exit For
            End If
        Next j
        
        If j > UBound(ZJId) Then '没有找到
            
            Rs_Zj.AddNew
            Rs_Zj.Fields("zjname") = Trim(NewSheet.Cells(i, 8))
            Rs_Zj.Update
            
            ReDim Preserve ZJStr(j)
            ReDim Preserve ZJId(j)
            
            ZJStr(j) = Trim(NewSheet.Cells(i, 8))
            ZJId(j) = Rs_Zj.Fields("zjid") & ""
        
        End If
        
        
        Rs.AddNew
        
        
        RichTextBox2.TextRTF = Trim(NewSheet.Cells(i, 1))
        Rs.Fields("TMStra") = (RichTextBox2.TextRTF)
        
        Dim a As String
        
        If Len(NewSheet.Cells(i, 2)) > 2 Then
            a = Left(NewSheet.Cells(i, 2), 2)
            If InStr(a, "A") Then
                NewSheet.Cells(i, 2) = Mid(NewSheet.Cells(i, 2), 2, Len(NewSheet.Cells(i, 2)))
            End If
        End If
        
        
        If Len(NewSheet.Cells(i, 3)) > 2 Then
            a = Left(NewSheet.Cells(i, 3), 2)
            If InStr(a, "B") Then
                NewSheet.Cells(i, 3) = Mid(NewSheet.Cells(i, 3), 2, Len(NewSheet.Cells(i, 3)))
            End If
        End If
        
        
        If Len(NewSheet.Cells(i, 4)) > 2 Then
            a = Left(NewSheet.Cells(i, 4), 2)
            If InStr(a, "C") Then
                NewSheet.Cells(i, 4) = Mid(NewSheet.Cells(i, 4), 2, Len(NewSheet.Cells(i, 4)))
            End If
        End If
        
        
        If Len(NewSheet.Cells(i, 5)) > 2 Then
            a = Left(NewSheet.Cells(i, 5), 2)
            If InStr(a, "D") Then
                NewSheet.Cells(i, 5) = Mid(NewSheet.Cells(i, 5), 2, Len(NewSheet.Cells(i, 5)))
            End If
        End If
        
        
        
        If Len(NewSheet.Cells(i, 6)) > 2 Then
            a = Left(NewSheet.Cells(i, 6), 2)
            If InStr(a, "E") Then
                NewSheet.Cells(i, 6) = Mid(NewSheet.Cells(i, 6), 2, Len(NewSheet.Cells(i, 6)))
            End If
        End If
        
        
        
        
        
        
        
        
        Rs.Fields("XXA") = (Trim(NewSheet.Cells(i, 2)))
        Rs.Fields("XXB") = (Trim(NewSheet.Cells(i, 3)))
        Rs.Fields("XXC") = (Trim(NewSheet.Cells(i, 4)))
        Rs.Fields("XXD") = (Trim(NewSheet.Cells(i, 5)))
        Rs.Fields("XXE") = (Trim(NewSheet.Cells(i, 6)))
        Rs.Fields("ZJID") = ZJId(j)

        
        
        
        If Len(Trim(NewSheet.Cells(i, 7))) = "1" Then
                    
                If Trim(UCase(NewSheet.Cells(i, 7))) = "A" Or Trim(UCase(NewSheet.Cells(i, 7))) = "B" Or Trim(UCase(NewSheet.Cells(i, 7))) = "C" Or Trim(UCase(NewSheet.Cells(i, 7))) = "D" Or Trim(UCase(NewSheet.Cells(i, 7))) = "E" Then
                    Rs.Fields("TMtype") = "单选"
                    
                    Select Case Trim(NewSheet.Cells(i, 7))
                        Case "A"
                           Rs.Fields("TMDA") = 0
                        Case "B"
                            Rs.Fields("TMDA") = 1
                        Case "C"
                            Rs.Fields("TMDA") = 2
                        Case "D"
                            Rs.Fields("TMDA") = 3
                        Case "E"
                            Rs.Fields("TMDA") = 4
                    End Select
                    
                    
                    
                End If
               
                If Trim(NewSheet.Cells(i, 7)) = "0" Or Trim(NewSheet.Cells(i, 7)) = "1" Then
                    Rs.Fields("TMtype") = "判断"
                    Rs.Fields("TMDA") = Trim(NewSheet.Cells(i, 7))
                    
                    
                End If
               
            Else
                Rs.Fields("TMtype") = "多选"
               
                Dim DXStr As String
               
                DXStr = ""
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "A") Then
                        DXStr = DXStr & "0"
                    Else
                        DXStr = DXStr & "6"
                    End If
                    
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "B") Then
                        DXStr = DXStr & "1"
                    Else
                        DXStr = DXStr & "6"
                    End If
                    
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "C") Then
                        DXStr = DXStr & "2"
                    Else
                        DXStr = DXStr & "6"
                    End If
                    
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "D") Then
                        DXStr = DXStr & "3"
                    Else
                        DXStr = DXStr & "6"
                    End If
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "E") Then
                        DXStr = DXStr & "4"
                    Else
                        DXStr = DXStr & "6"
                    End If
                    
               
               
                 Rs.Fields("TMDA") = (DXStr)
            End If
            
            Rs.MoveNext
            
        
        
    Next i
   
    Label1.Caption = "读取完毕!共读取" & i - 2 & "个记录"
   
    Rs.MoveFirst
   
    Label1.Caption = "正在重新分配题目号码!"
   
    For i = 1 To UBound(ZJId)
        DoEvents
        Sql = "select * from tminfo where zjid=" & ZJId(i)
        Set Rs = ExecuteSQL(Sql, MsgTxt)
        Label1.Caption = "正在重新分配题目号码 ID:" & ZJId(i)
        
        If Rs.RecordCount > 0 Then
            
            
            For j = 1 To Rs.RecordCount
                DoEvents
                Rs.Fields("TMNum") = j
                Rs.Update
               
                Label1.Caption = "正在重新分配题目号码 ID:" & ZJId(i) & " 题目号码:" & j
                Rs.MoveNext
            Next j
            
            
            
            
            
        End If
        
        
        
   
    Next i
   
   
   
   
   
   
   
   
   
    MsgBox "题目导入完毕!", vbInformation, "消息提示"
   
   
    RichTextBox1.Text = ""
   
    ListView2.HideSelection = False
    ListView1.HideSelection = False
   
    If ListView2.ListItems.Count > 0 Then
   
        Call ListView2_ItemClick(ListView2.ListItems.Item(1))
    End If
    NewBook.Save
    NewBook.Close
    NewApp.Quit
    Set NewApp = Nothing
err1:
    If Err.Number > 0 Then
        MsgBox Err.Description, vbCritical, "错误提示"
        Exit Sub
    End If
   
End Sub
2017-03-31 10:41
natesc
Rank: 1
等 级:新手上路
帖 子:40
专家分:0
注 册:2013-9-15
收藏
得分:0 
十分感谢,软件导入后,关了软件后,打开进程,在进程中依然看到EXCELL有运行。再次打开电子表格依然是提示已打开。

[此贴子已经被作者于2017-3-31 16:02编辑过]

附件: 游客没有浏览附件的权限,请 登录注册
2017-03-31 15:34
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
收藏
得分:0 
我调试的正常,在进程里反复找,都没有excel.exe的。
2017-03-31 17:14
natesc
Rank: 1
等 级:新手上路
帖 子:40
专家分:0
注 册:2013-9-15
收藏
得分:0 
回复 6楼 xzlxzlxzl
这就奇怪了,我调试在进程中有,同时发现打开导入的电子表格也显示已打开。
2017-03-31 19:03
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
收藏
得分:0 
我发修改后的工程及运行效果你看看,你可以试运行我发给你的工程。


附件: 游客没有浏览附件的权限,请 登录注册
2017-03-31 19:20
natesc
Rank: 1
等 级:新手上路
帖 子:40
专家分:0
注 册:2013-9-15
收藏
得分:0 
回复 8楼 xzlxzlxzl
谢谢,这个应当可以,但没看出和你当初的代码有什么不同。但这次可以关闭。再次感谢
2017-03-31 21:32
natesc
Rank: 1
等 级:新手上路
帖 子:40
专家分:0
注 册:2013-9-15
收藏
得分:0 
回复 8楼 xzlxzlxzl
虽然可以用,但没有搞懂。你的程序和4楼代码好像一样的,为什么4楼时测试不成功。还 有哪修改了代码吗?请赐教
2017-03-31 23:12
快速回复:电子表格导入到ACCESS后关不了,各种方法都试过,附原程序
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.054838 second(s), 8 queries.
Copyright©2004-2020, BCCN.NET, All Rights Reserved