0
答：設置XlBook = Xl.Workbooks.Open（MySheetPath）Excel的VBA從MS Access宏 - 對象變量或與塊變量未設置
我試圖解決別人的宏。他們在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移：= xlUp」
如果我評論說出來我再得到它「ActiveWorkbook.RefreshAll」 （選擇，ActiveCell.SpecialCells（xlLastCell））。選擇「相同的錯誤塊/變量未設置」。選擇「相同的錯誤塊/變量未設置」。我只是在這裏虧本。當我在宏的宏記錄器相同類型的宏工作，但來自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
我現在改爲
XlBook.Sheets("Item Detail Frozen").Select
Set XlSheet = XlBook.Worksheets("Item Detail Frozen")
XlSheet.Cells.Clear
XlBook.Sheets("Item Detail").Select
Set XlSheet = XlBook.Worksheets("Item Detail")
With XlSheet
Xl.WindowState = xlMinimized
XlBook.RefreshAll
XlSheet.Range("A1:D1").Select
XlSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
End With
現在的錯誤是XlSheet.Range（選擇，ActiveCell.SpecialCells（xlLastCell）），選擇和它是一樣的沒有設置錯誤。
我改變了，並收到一個新的錯誤。往上看。 – 2014-09-22 18:06:12
將設置更改爲編輯答案。 – 2014-09-22 18:15:03