重新运行脚本时，VBA访问Excel导出，错误1004和70

I have the following script - it's supposed to Export the Access table "vrt_master" into an Excelsheet, do a bit of formatting and Close the file afterwards. The first time the script runs without Problems, but when I try to re-run it I get the error: "Runtime Error 70: permission denied" when it tries to delete the old file (see code appended) and "Runtime Error 1004: The Method "Cells" for the Object "_Global" failed".

我有以下脚本 - 它应该将Access表“vrt_master”导出到Excel表格中,进行一些格式化并随后关闭文件。第一次脚本运行没有问题,但当我尝试重新运行它时,我得到错误:“运行时错误70:权限被拒绝”当它尝试删除旧文件(请参阅附加代码)和“运行时错误1004:对象“_Global”的方法“单元格”失败“。

Somehow the Excelsheet doesn't close properly (I can find 1 or more EXCEL.EXE processes in my Task Manager even though the file is closed).

不知何故,Excel表格没有正确关闭(我可以在我的任务管理器中找到一个或多个EXCEL.EXE进程,即使该文件已关闭)。

Public Sub Select_in_Excel_anzeigen()

 Dim sDatei As String
 sDatei = "C:\Users\a.hopf\Desktop\Export_Vertriebsreporting_Test2.xlsx"
 If Dir(sDatei) <> "" Then
 Kill sDatei
 End If

' (above) this is where I get Error 70

'(上图)这是我得到错误70的地方

 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "vrt_master", "C:\Users\a.hopf\Desktop\Export_Vertriebsreporting_Test2.xlsx", True, ""

Dim xlApp As Excel.Application
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\Users\a.hopf\Desktop\Export_Vertriebsreporting_Test2.xlsx")
Set xlSheet = xlBook.Worksheets(1) ' 1. Tabellenblatt in Excel festlegen

With xlSheet                    


Dim LastColumn As Long
With xlSheet
    LastColumn = Cells.Find(What:="*", After:=[$A1], _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column

' (above) this is where I get Run-time error '1004' - Method 'Range' of object'_Global' failed

'(上图)这是我得到运行时错误'1004' - 对象'_Global'的方法'范围'失败

End With
Dim LastRow As Long
With xlSheet
    LastRow = Cells.Find(What:="*", After:=[A$1], _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row
End With
xlSheet.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(LastRow, LastColumn)), , xlYes).Name = _
"Table1"

' (above) this is where I get Run-time error 1004 Table Cannot Overlap A Range

'(上图)这是我得到的运行时错误1004表不能重叠范围

Range(Cells(1, 1), Cells(LastRow, LastColumn)).Select
xlSheet.ListObjects("Table1").TableStyle = "TableStyleLight2"

Columns(LastColumn).Select
Selection.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireColumn.Hidden = True

xlSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(LastRow, 12)).Address

 Rows(LastRow).Select
Selection.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True

End With
xlBook.Save
xlBook.Close
xlApp.Application.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

I would be very thankful for any help, Alwin

Alwin,我非常感谢任何帮助

1 个解决方案

#1

This should fix your issues with orphaned processes:

这应该可以解决孤立进程的问题:

Public Sub Select_in_Excel_anzeigen()

    Dim sDatei                As String
    Dim xlApp                 As Excel.Application
    Dim xlBook                As Workbook
    Dim xlSheet               As Worksheet
    Dim LastColumn            As Long
    Dim LastRow               As Long

    sDatei = "C:\Users\a.hopf\Desktop\Export_Vertriebsreporting_Test2.xlsx"
    If Dir(sDatei) <> "" Then Kill sDatei
    ' (above) this is where I get Error 70

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "vrt_master", "C:\Users\a.hopf\Desktop\Export_Vertriebsreporting_Test2.xlsx", True, ""

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("C:\Users\a.hopf\Desktop\Export_Vertriebsreporting_Test2.xlsx")
    Set xlSheet = xlBook.Worksheets(1)    ' 1. Tabellenblatt in Excel festlegen

    With xlSheet
        LastColumn = .Cells.Find(What:="*", After:=.Range("A1"), _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column

        LastRow = .Cells.Find(What:="*", After:=.Range("A1"), _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious).Row

        With .ListObjects.Add(xlSrcRange, .Range(.Cells(1, 1), .Cells(LastRow, LastColumn)), , xlYes)
            .Name = "Table1"
            .TableStyle = "TableStyleLight2"
        End With

        .Range(.Cells(1, LastColumn), .Cells(1, .Columns.Count)).EntireColumn.Hidden = True

        .PageSetup.PrintArea = "A1:L" & LastRow

        .Range(.Cells(LastRow, 1), .Cells(.Rows.Count, 1)).EntireRow.Hidden = True

    End With
    xlBook.Close True
    xlApp.Quit
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing

End Sub