[已解决]下面这段代码中，为何不能删除打开过的文件(fn为打开的文件名）

tinytiger

Sub AccessWeb()
  Dim TR%, TC%, kq%,  bq%, rng As Range, kb1$, kb2$,  RJLc%, WCLc%, SYL!, QD!, RJL!, WCL!, fn
  TR = ActiveCell.Row
  TC = ActiveCell.Column
  bq = 0
  l = Val(ThisWorkbook.ActiveSheet.Name)
  myPath = ThisWorkbook.Path & "\"
  wbn = ThisWorkbook.Name
  wbn = Left(wbn, InStrRev(wbn, ".") - 1)
  Year_Num = Sheets("科室设置").Range("D1").Value
  Dept = Sheets("科室设置").Range("B1")
  kb1 = Left(Dept, 2)
  kb2 = Left(Right(Dept, 3), 1)
  On Error Resume Next
  If TC = 7 And Month(Date) > l Then
    If TR = 10 Or TR = 11 Then
      MsgBox "请打开" & myPath & l & "月份《临床路径入径率，完成率统计表》！"
      On Error Resume Next
      ChDrive Mid(ThisWorkbook.Path, 1, 1)
      ChDir ThisWorkbook.Path
      fn = Application.GetOpenFilename("Excel文件,*.xls,Excel文件,*.xlsx,Excel文件,*.xlsm")
      If fn = CStr(False) Then
        MsgBox "没有选择文件，不能导入数据！"
        Exit Sub
      End If
      With Workbooks.Open(fn)
        For Each rng In ActiveSheet.UsedRange
          If Replace(rng.Value, " ", "") = "科室名称" Then kq = rng.Column
          If InStr(Replace(rng.Value, " ", ""), "入径率") > 0 Then RJLc = rng.Column
          If InStr(Replace(rng.Value, " ", ""), "完成率") > 0 Then WCLc = rng.Column
        Next
        For Each rng In ActiveSheet.UsedRange
          If InStr(Replace(rng.Value, " ", ""), kb1) > 0 Then
            bq = rng.Row
            If InStr(Replace(rng.Value, " ", ""), kb2) > 0 Then
              bq = rng.Row
              Exit For
            End If
          End If
        Next
        If bq = 0 Or RJLc = 0 Or WCLc = 0 Then
          MsgBox "没有查找到相应的科室或项目，请手工查找相关数据！"
          Exit Sub
        Else
          RJL = Cells(bq, RJLc).Value
          WCL = Cells(bq, WCLc).Value
        End If
        .Close SaveChanges:=False
      End With
      Kill myPath & fn
      Workbooks(wbn & ".xls").Sheets( l & "月份质控月报表").Activate
      Range("G10").Value = VBA.Format(RJL, "0.00%")
      Range("G11").Value = VBA.Format(WCL, "0.00%")
      ThisWorkbook.Save
    End If
  End If
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2015-6-4 07:56

关于此部分可简化为：
Sub AccessWeb()
      fn = Application.GetOpenFilename("Excel文件,*.xls,Excel文件,*.xlsx,Excel文件,*.xlsm")
      With Workbooks.Open(fn)
        .Close SaveChanges:=False
      End With
     ' Kill myPath & fn
     Kill  fn
End Sub

跳转到最佳答案楼层

zjdh

关于此部分可简化为：
Sub AccessWeb()
      fn = Application.GetOpenFilename("Excel文件,*.xls,Excel文件,*.xlsx,Excel文件,*.xlsm")
      With Workbooks.Open(fn)
        .Close SaveChanges:=False
      End With
     ' Kill myPath & fn
     Kill  fn
End Sub

tinytiger

zjdh 发表于 2015-6-4 07:56
关于此部分可简化为：
Sub AccessWeb()
      fn = Application.GetOpenFilename("Excel文件,*.xls,Excel ...

谢谢！