Access交流中心

北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |

文件导入后,关机时还会打开我先前打开的Excel

felix  发表于:2011-04-14 17:14:28  
复制

大家帮我看看,那里错了。文件导入后,电脑关机时还会打开我先前导入的Excel文件,不能退出。

 

Private Sub cmdImportFromExcel_Click()
On Error GoTo Err_cmdImportFromExcel_Click
    Dim strPathName As String           '输出文件路径名
    Dim objApp  As Object               'Excel程序
    Dim objBook As Object               'Excel工作簿
    Dim rst As Object                   '子窗体记录集
    Dim curSum As Currency              '折后金额总计
    Dim intN As Integer                 '循环计数器
   
     '通过对话框取得Excel文件名
    With FileDialog(3) 'msoFileDialogOpen
        .InitialFileName = CurrentProject.Path
        .Filters.Clear
        .Filters.Add "Microsoft Excel", "*.xls"
        If .Show Then strPathName = .SelectedItems(1)
    End With
    '对话框取消则退出过程
    If strPathName = "" Then Exit Sub
   
   '设置鼠标指针为沙漏形状
    DoCmd.Hourglass True
    '创建Excel对象
    Set objApp = CreateObject("Excel.Application")
    '打开模板文件
    Set objBook = objApp.Workbooks.Open(strPathName)
    '选中激活"Sheet1"工作表
    objBook.Sheets("Sheet1").Select
    Me.Hotel.SetFocus
    If Not Me.NewRecord Then DoCmd.RunCommand acCmdRecordsGoToNew
    With objApp
       '根据读取订单表头
        Me.Company = .Range("E2")
        Me.MonthID = .Range("J6")
        Me.YearID = .Range("H2")
        Me.ABFlag = .Range("I2")
          Me.Hotel = .Range("E2")
        Me.MonthID = .Range("J6")
        Me.YearID = .Range("H2")
        Me.ABFlag = .Range("I2")
        Me.[99100] = .Range("J8")
            Me.[99101] = .Range("J10")
         
                    
        '保存主窗体记录
        Me.Dirty = False
        '取得工作表中的有效数据行数
         End With
  
   
   '设置鼠标指针为沙漏形状
    DoCmd.Hourglass True
    '创建Excel对象
    Set objApp = CreateObject("Excel.Application")
    '打开模板文件
    Set objBook = objApp.Workbooks.Open(strPathName)
    '选中激活"Sheet1"工作表
    objBook.Sheets("Sheet1").Select
    Me.Hotel.SetFocus
    If Not Me.NewRecord Then DoCmd.RunCommand acCmdRecordsGoToNew
    With objApp
       '根据读取订单表头
        Me.Company = .Range("E2")
        Me.MonthID = .Range("K6")
        Me.YearID = .Range("H2")
        Me.ABFlag = .Range("I2")
          Me.Hotel = .Range("E2")
        Me.MonthID = .Range("K6")
        Me.YearID = .Range("H2")
        Me.ABFlag = .Range("I2")
        Me.[99100] = .Range("K8")
            Me.[99101] = .Range("K10")
         
        '保存主窗体记录
        Me.Dirty = False
        '取得工作表中的有效数据行数
         End With
  
   
      

    MsgBox "导入成功!", vbInformation, "提示"
   
Exit_cmdImportFromExcel_Click:
    If Not objBook Is Nothing Then objBook.Saved = True
    If Not objApp Is Nothing Then objApp.Quit
    '恢复鼠标指针
    DoCmd.Hourglass False
    '释放对象变量内存
    Set objApp = Nothing
    Set objBook = Nothing
    Set rst = Nothing
    Exit Sub

Err_cmdImportFromExcel_Click: '错误处理程序
    MsgBox Err & vbCrLf & Err.Description, vbCritical, "出错"
    Resume Exit_cmdImportFromExcel_Click
   
   
   
End Sub

 

Top
总记录:0篇  页次:0/0 9 1 :