MS Access中的Excel VBA宏-对象变量或未设置块变量

回答：设置XlBook=Xl.Workbooks.Open（MySheetPath）

我正在尝试对其他人的宏进行故障排除。他们在Access数据库中有一些影响excel工作簿的宏

有两段代码有问题

XlBook.Sheets("Item Detail Frozen").Select
Set XlSheet = XlBook.Worksheets("Item Detail Frozen")
With XlSheet
   XlSheet.Cells.Select
   XlSheet.Range("A1").Activate
   Selection.Delete Shift:=xlUp

End With

XlBook.Sheets("Item Detail").Select
Set XlSheet = XlBook.Worksheets("Item Detail")
With XlSheet
    Xl.WindowState = xlMinimized
    ActiveWorkbook.RefreshAll
    .Range("A1:D1").Select
    .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
End With

我得到“对象变量或未设置块变量” “Selection.Delete Shift:=xlUp”

如果我把它注释掉，我会在“ActiveWorkbook.RefreshAll”中找到它

我通过主动设置活动书本来解决这个问题，然后我开始使用它 .Range（Selection，ActiveCell.SpecialCells（xlLastCell））。选择“未设置相同的错误块/变量”。我只是在这里不知所措。当我在excel中使用宏录制器时，同一类型的宏可以工作，但当来自Access时，它不喜欢它

下面是完整的代码

    Option Compare Database
    Option Explicit

    Function FileExists(ByVal FileToTest As String) As Boolean
       FileExists = (Dir(FileToTest) <> "")
    End Function
    Sub DeleteFile(ByVal FileToDelete As String)

    DeleteFile:

       If FileExists(FileToDelete) Then 'See above
          On Error GoTo DeleteFile_ErrorHandler
          Kill FileToDelete
       End If
       Exit Sub
    DeleteFile_ErrorHandler:
       On Error Resume Next
       MsgBox "There was an error deleteing the file(s), " & FileToDelete & _
              ".  Check to see if you or any one has any of these files open and have them closed; then press OK.  "

    End Sub



    Public Function PrepareOutputFile() As Variant
        'Variables to refer to Excel and Objects
        Dim MySheetPath As String
        Dim Xl As Excel.Application
        Dim XlBook As Excel.Workbook
        Dim XlSheet As Excel.Worksheet
        Dim NewFilePath As String
        Dim NewPathDir As String
        Dim LastSlashPos      As String
        Dim AttachmentDir      As String
        Dim NewFileWildCard      As String
        Dim NewFileName As String


        ' Tell it location of actual Excel file
        MySheetPath = "W:\Sams-LibertySport\Sams-LibertySport- Week #x - as of mm-dd-yyyy.xls"

        'Open Excel and the workbook
        Set Xl = CreateObject("Excel.Application")
        Set XlBook = GetObject(MySheetPath)

        'Make sure excel is visible on the screen
        Xl.Visible = True
        XlBook.Windows(1).Visible = True

        XlBook.Sheets("Item Detail Frozen").Select
        Set XlSheet = XlBook.Worksheets("Item Detail Frozen")
        'With XlSheet

         '   .Cells.Select
          '  .Range("A1:D1").Activate
           ' Selection.Delete Shift:=xlUp

        'End With
        With XlSheet
           XlSheet.Cells.Select
           XlSheet.Range("A1").Activate
           Selection.Delete Shift:=xlUp

        End With

        XlBook.Sheets("Item Detail").Select
        Set XlSheet = XlBook.Worksheets("Item Detail")
        With XlSheet
            Xl.WindowState = xlMinimized
            ActiveWorkbook.RefreshAll
            .Range("A1:D1").Select
            .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
            Selection.Copy
        End With

        XlBook.Sheets("Item Detail Frozen").Select
        Set XlSheet = XlBook.Worksheets("Item Detail Frozen")
        With XlSheet

            .Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            .Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            .Cells.Select
            .Cells.EntireColumn.AutoFit
            Xl.CutCopyMode = False
            ChDir "W:\"
            NewFilePath = Replace(Replace(Replace(MySheetPath, "W:\", "R:\"), _
                           "#x", "#" & CInt(Right(DLookup("EndingWmWeek", "Period", "PeriodCode='LW'"), 2))), _
                          "mm-dd-yyyy", Format(DLookup("[As-of Date]", "As-of Date"), "mm-dd-yyyy"))
            LastSlashPos = InStrRev(NewFilePath, "\")
            AttachmentDir = Left(NewFilePath, LastSlashPos - 1) & "\EmailAttachments"
            NewFileWildCard = Mid(NewFilePath, LastSlashPos + 1, InStr(LastSlashPos, NewFilePath, "-", vbTextCompare) - LastSlashPos) & "*.*"
            NewFileName = Mid(NewFilePath, LastSlashPos + 1, Len(NewFilePath) - LastSlashPos)


            While FileExists(NewFilePath)
                DeleteFile NewFilePath
            Wend
            ActiveWorkbook.SaveAs FileName:= _
                NewFilePath, FileFormat:= _
                xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
                , CreateBackup:=False

        End With
        XlBook.Sheets("TopLine Overview").Select
        Set XlSheet = XlBook.Worksheets("TopLine Overview")
        XlSheet.Range("A1").Select
        XlSheet.Range("A1").Activate
        ActiveWorkbook.Save

        'Clean up and end with worksheet visible on the screen
        ActiveWorkbook.Close (False) 'Discard changes
        Set XlSheet = Nothing
        Set XlBook = Nothing
        Xl.Quit
        Set Xl = Nothing

        While FileExists(AttachmentDir & "\" & NewFileWildCard)
            DeleteFile AttachmentDir & "\" & NewFileWildCard
        Wend
        FileCopy NewFilePath, AttachmentDir & "\" & NewFileName

    End Function


    Public Sub PrepareDownloadedMdbFiles()

        'Variables to refer to Excel and Objects
        Dim MyDBPath As String
        Dim Db As Database
        Dim NewDBName As String

        Dim fdr As String
        Dim filenames() As String
        Dim FileIndex As Integer
        Dim fileCount As Integer
        FileIndex = 0

        filenames = GetFileNames("W:\lib394a_*.mdb")
        For FileIndex = 0 To UBound(filenames) - 1

            fdr = filenames(FileIndex)
            'Open Database
            Set Db = Workspaces(0).OpenDatabase("W:\" & fdr)
            Dim td As TableDef
            NewDBName = ""
            For Each td In Db.TableDefs
                If Left(td.Name, 4) <> "Msys" Then
                    NewDBName = td.Name
                End If
            Next td
            Db.Close

            If NewDBName <> "" Then

                DeleteFile "W:\" & NewDBName & ".mdb"
                Name "W:\" & fdr As "W:\" & NewDBName & ".mdb"

            End If
        Next FileIndex


    End Sub

    Public Function GetFileNames(Template As String) As String()

        'Given a FileName template such as W:\ab*.*, return an array of filenames

        Dim MyDBPath As String
        Dim Db As Database
        Dim NewDBName As String

        Dim fdr As String
        Dim filenames() As String
        Dim FileIndex As Integer
        Dim fileCount As Integer
        FileIndex = 0
        ReDim filenames(0)

        fdr = Dir(Template)
        Do While fdr <> ""
            ReDim Preserve filenames(FileIndex + 1)
            filenames(FileIndex) = fdr
            FileIndex = FileIndex + 1
            fdr = Dir()
        Loop

        GetFileNames = filenames

    End Function

现在，错误出现在XlSheet.Range（Selection，ActiveCell.SpecialCells（xlLastCell））.Select上，与未设置错误相同。

Oh- 我想你在片场上看到了错误

Set XlBook = Xl.Workbooks.Open(MySheetPath)

这将删除工作表上的所有数据，为什么不：

Worksheets(("Item Detail Frozen").Cells.Clear

---

在很多情况下，错误并不表明什么是错误的，特别是在从一个办公产品控制另一个办公产品时。当您删除该行，并且错误发生在下一行时，这清楚地表明它不是导致问题的原因

保留所有原始代码，但正在修复 设置XlBook=Xl.Workbooks.Open（MySheetPath）

修复了所有错误。使用另一种打开excel文件的方法似乎不是最理想的。谢谢你的帮助

Worksheets(("Item Detail Frozen").Cells.Clear