如何使VBA代碼運行特定的Excel文件？

Question

我在查找錯誤時遇到了困難：我想要做的就是僅在Book1.xls的Sheet1上運行此代碼，即使在其他Excel文件或此文件的其他工作表中工作時也是如此。所有的代碼的第一部分工作正常，直到** -line但後來當我在不同的頁面或文件它「嗆」，並給我一個錯誤。

Sub Upload0() 

' Upload Webpage content 
Application.OnTime Now + TimeValue("00:00:10"), "Upload0" 
With Workbooks("Book1.xls").Sheets("Sheet1").QueryTables.Add(Connection:= _ 
    "URL;http://cetatenie.just.ro/ordine/articol-11", Destination:=Workbooks("Book1.xls").Sheets("Sheet1").Range("A1")) 
    .Name = "CetatenieOrdine" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = True 
    .BackgroundQuery = True 
    .RefreshStyle = xlOverwriteCells 
    .SavePassword = True 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .WebSelectionType = xlEntirePage 
    .WebFormatting = xlWebFormattingNone 
    .WebPreFormattedTextToColumns = True 
    .WebConsecutiveDelimitersAsOne = True 
    .WebSingleBlockTextImport = False 
    .WebDisableDateRecognition = False 
    .WebDisableRedirections = False 
    .Refresh BackgroundQuery:=False 
    End With 

' Deletes Empty Cells 
Workbooks("Book1.xls").Sheets("Sheet1").Range("A1").Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 

****************************************************************************** 

' Deletes useless Rows and fits the Width 
Rows("1:31").Select 
Selection.Delete Shift:=xlUp 
Range("B28").Select 
Selection.End(xlDown).Select 
Rows("17:309").Select 
Selection.Delete Shift:=xlUp 


' Text to Column function with auto-confirmation to overwrite 
Columns("A:A").Select 
Application.DisplayAlerts = False 
Selection.TextToColumns Destination:=Columns("A:A"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 
Application.DisplayAlerts = True 

Columns("B:B").Select 
Application.DisplayAlerts = False 
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ 
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _ 
    :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _ 
    TrailingMinusNumbers:=True 
Application.DisplayAlerts = True 
Columns("B:B").Select 
Selection.Delete Shift:=xlToLeft 


' fit the Width of All Columns 
Cells.Select 
Range("A37").Activate 
Cells.EntireColumn.AutoFit 
Range("H1").Select 
Rows("1:1").Select 
Selection.Font.bold = True 

End Sub 

Answer 1

當訪問Rows或Range而不指定的片材，使用VBA ActiveSheet。在這種情況下，你應該明確地指定要使用工作表：

Sub Upload0() 

' Upload Webpage content 
Application.OnTime Now + TimeValue("00:00:10"), "Upload0" 
With Workbooks("Book1.xls").Sheets("Sheet1").QueryTables.Add(Connection:= _ 
    "URL;http://cetatenie.just.ro/ordine/articol-11", Destination:=Workbooks("Book1.xls").Sheets("Sheet1").Range("A1")) 
    .Name = "CetatenieOrdine" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = True 
    .BackgroundQuery = True 
    .RefreshStyle = xlOverwriteCells 
    .SavePassword = True 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .WebSelectionType = xlEntirePage 
    .WebFormatting = xlWebFormattingNone 
    .WebPreFormattedTextToColumns = True 
    .WebConsecutiveDelimitersAsOne = True 
    .WebSingleBlockTextImport = False 
    .WebDisableDateRecognition = False 
    .WebDisableRedirections = False 
    .Refresh BackgroundQuery:=False 
    End With 

' Deletes Empty Cells 
Workbooks("Book1.xls").Sheets("Sheet1").Range("A1").Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 

****************************************************************************** 
With Workbooks("Book1.xls").Sheets("Sheet1") 
    ' Deletes useless Rows and fits the Width 
    .Rows("1:31").Delete Shift:=xlUp 
    .Rows("17:309").Delete Shift:=xlUp 


    ' Text to Column function with auto-confirmation to overwrite 
    Application.DisplayAlerts = False 
    .Columns("A:A").TextToColumns Destination:=Columns("A:A"), DataType:=xlDelimited, _ 
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ 
      Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
      :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 
    .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _ 
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ 
      Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _ 
      :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _ 
      TrailingMinusNumbers:=True 
    Application.DisplayAlerts = True 
    .Columns("B:B").Delete Shift:=xlToLeft 


    ' fit the Width of All Columns 
    .Cells.EntireColumn.AutoFit 
    .Rows("1:1").Font.bold = True 
End With 

End Sub