Excel无法访问文件

只是在工作中做一些事情，并尝试在VBA上引用网络目录中的文件

Sub CostPriceMain()

Application.ScreenUpdating = False

Application.DisplayAlerts = False


NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files 
(*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)


If NewFile = False Then Exit Sub

If NewFile <> False Then

Set wkbk = Workbooks.Open(NewFile)

End If



Dim Sh As Worksheet
For Each Sh In wkbk.Worksheets
    If Sh.Visible = True Then
        Sh.Activate
        Sh.Cells.Copy
        Workbooks("S:\Stafford\WK24 WH.xls").Sheets("Name").Range("A1").PasteSpecial Paste:=xlValues
    End If
Next Sh
Application.CutCopyMode = False



ActiveWorkbook.Close True


Application.ScreenUpdating = True

Application.DisplayAlerts = True


Done = MsgBox("Task Complete", vbOKOnly)

End Sub

Sub-CostPriceMain（）
Application.ScreenUpdating=False
Application.DisplayAlerts=False
NewFile=Application.GetOpenFilename（文件过滤器：=”Microsoft Excel文件
（*.xlsx；*.xls），（*.xlsx；*.xls），所有文件，*.*，过滤器索引：=1）
如果NewFile=False，则退出Sub
如果NewFile为False，则
设置wkbk=Workbooks.Open（新文件）
如果结束
将Sh设置为工作表
对于wkbk.工作表中的每个Sh
如果Sh.Visible=True，则
Sh.激活
Sh.Cells.Copy
工作簿（“S:\Stafford\WK24 WH.xls”）。工作表（“名称”）。范围（“A1”）。粘贴特殊粘贴：=xlValues
如果结束
下一个Sh
Application.CutCopyMode=False
ActiveWorkbook.Close为真
Application.ScreenUpdating=True
Application.DisplayAlerts=True
Done=MsgBox（“任务完成”，仅vbOKOnly）
端接头

我正在尝试打开它，以便我可以将wkbk中的数据粘贴到其中。但是，我不断收到“Microsoft Office Excel无法访问文件”运行时错误1004

---

这是不是因为文件不是本地存储的？当我对此感到抓狂时。

您在循环中打开工作簿，这意味着它将尝试为每个工作表打开它-并且在它已经打开时抛出一个错误

在开始循环之前打开工作簿，然后直接引用它。此代码将包含代码的工作簿中的每个可见工作表复制到WK24.xls（注意，无需激活工作表）：

编辑：

我对您发布的代码做了一些更改。
我删除了

如果NewFile=False，则退出Sub

——如果NewFile不是False，它将运行代码，否则它将直接跳到末尾。它为您的程序提供了一个单一的退出点。
我已将

ActiveWorkbook.Close True

更新到引用的工作簿<代码>活动工作簿可能并不总是正确的书籍-总是最好避免活动或选择。。。如果您发现自己正在使用（或激活、选择或任何类似功能），那么您可能正在为自己做更多的工作。
您的

MsgBox

不会对任何响应执行操作，它只是通知您，因此无需将其设置为变量

如果您仍然发现工作簿无法访问，请再次检查文件位置、文件名以及是否已打开。
哪个文件导致了问题？新文件还是WK24

另外，如果您正在复制整个工作表、工作表中的单元格、复制和粘贴，请继续更改代码

Sub CostPriceMain()

    Dim NewFile As Variant
    Dim wkbk As Workbook
    Dim wrkBk As Workbook
    Dim wrkSht As Worksheet

    NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files     (*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)

    If NewFile <> False Then

        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

        Set wkbk = Workbooks.Open(NewFile)
        Set wrkBk = Workbooks.Open("S:\Stafford\WK24.xls")

        For Each wrkSht In wkbk.Worksheets
            If wrkSht.Visible Then
                'Copy all cells with formula, etc.
                'wrkSht.Cells.Copy Destination:=wrkBk.Worksheets("Sheet1").Range("A1")

                'Copy and pastespecial all cells.
                'wrkSht.Cells.Copy
                'wrkBk.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues

                'Copy whole sheet to WK2 (Sheets includes ChartSheets)
                wrkSht.Copy After:=wrkBk.Sheets(wrkBk.Sheets.Count)
            End If
        Next wrkSht

        wrkBk.Close True  'Closes WK24.
        wkbk.Close False 'Closes your chosen file without saving.

        Application.ScreenUpdating = True
        Application.DisplayAlerts = True

        MsgBox "Task Complete", vbOKOnly
    End If

End Sub

Sub-CostPriceMain（）
将新文件作为变量
将wkbk设置为工作簿
将wrkBk设置为工作簿
Dim wrkSht As工作表
NewFile=Application.GetOpenFilename（文件过滤器：=“Microsoft Excel文件（*.xlsx；*.xls），（*.xlsx；*.xls），所有文件，*.*”，过滤器索引：=1）
如果NewFile为False，则
Application.ScreenUpdating=False
Application.DisplayAlerts=False
设置wkbk=Workbooks.Open（新文件）
设置wrkBk=Workbooks.Open（“S:\Stafford\WK24.xls”）
对于wkbk.工作表中的每个wrkSht
如果wrkSht.可见，则
'使用公式等复制所有单元格。
'wrkSht.Cells.Copy Destination:=wrkBk.Worksheets（“Sheet1”）.Range（“A1”）
'复制并粘贴所有单元格。
'wrkSht.Cells.Copy
'wrkBk.工作表（“表1”）.范围（“A1”）.粘贴特殊XLPaste值
'将整张图纸复制到WK2（图纸包括图表图纸）
wrkSht.Copy After:=wrkBk.Sheets（wrkBk.Sheets.Count）
如果结束
下一个wrkSht
wrkBk.Close True“关闭WK24。
wkbk.Close False'关闭您选择的文件而不保存。
Application.ScreenUpdating=True
Application.DisplayAlerts=True
MsgBox“任务完成”，仅VBOK
如果结束
端接头

试试这个：

Sub CostPriceMain()

Dim SourceWkb As Workbook
Dim TargetWkb As Workbook
Dim SourceWksht As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files     (*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)

If NewFile = False Then Exit Sub
If NewFile <> False Then
    Set SourceWkb = Workbooks.Open(NewFile)
End If

Set TargetWkb = Workbooks.Open("S:\Stafford\WK24.xls") ' warning - XLS file could cause problems - see note

For Each SourceWksht In SourceWkb.Worksheets
    If SourceWksht.Visible Then
        SourceWksht.Copy After:=TargetWkb.Sheets(TargetWkb.Sheets.Count)
    End If
Next SourceWksht

TargetWkb.Close True
SourceWkb.Close False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Done = MsgBox("Task Complete", vbOKOnly)

End Sub

Sub-CostPriceMain（）
将SourceWkb设置为工作簿
将目标设置为工作簿
将源WKSHT设置为工作表
Application.ScreenUpdating=False
Application.DisplayAlerts=False
NewFile=Application.GetOpenFilename（文件过滤器：=“Microsoft Excel文件（*.xlsx；*.xls），（*.xlsx；*.xls），所有文件，*.*”，过滤器索引：=1）
如果NewFile=False，则退出Sub
如果NewFile为False，则
设置SourceWkb=Workbooks.Open（NewFile）
如果结束
设置TargetWkb=Workbooks.Open（“S:\Stafford\WK24.xls”）'警告-xls文件可能会导致问题-请参阅注释
对于SourceWkb.工作表中的每个SourceWksht
如果SourceWksht.可见，则
SourceWksht.Copy After:=TargetWkb.Sheets（TargetWkb.Sheets.Count）
如果结束
下一站
TargetWkb.Close为真
SourceWkb.Close为False
Application.ScreenUpdating=True
Application.DisplayAlerts=True
Done=MsgBox（“任务完成”，仅vbOKOnly）
端接头

---

我注意到您的“wk24”是一个

XLS

文件，但是您邀请用户选择要从中导入的

XLS

或

XLSX

文件。无法使用此方法将

XLSX

文件导入

XLS

文件。我建议您将目标文件更改为

WK24.XLSX

，如果有两张可见的工作表，则会将文件打开两次。。。这是通缉犯的行为吗？你也可以复制整张纸而不粘贴。。。这也是正确的吗？1004的一个原因是文件已经打开。。您似乎没有关闭循环中的文件，这意味着对于

wkbk.Worksheets

中的每个工作表，Excel都会尝试打开该文件。发生错误时，WK24.xls是否打开？我应该说wkbk是另一个文件，我正试图从中复制数据。但是要知道文件结束时没有打开。如果没有更新以显示完整的文本，那么如果变量的名称不那么相似，事情就不会那么混乱了<代码>wkbk和

wrkbk

？这是故意的吗？尝试调用它们

SourceWkb

和

TargetWkb

或类似的..？不幸的是，我仍然收到相同的错误。在我的代码中，wkbk实际上是我先前用Appli打开的另一个文件

Sub CostPriceMain()

Dim SourceWkb As Workbook
Dim TargetWkb As Workbook
Dim SourceWksht As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files     (*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)

If NewFile = False Then Exit Sub
If NewFile <> False Then
    Set SourceWkb = Workbooks.Open(NewFile)
End If

Set TargetWkb = Workbooks.Open("S:\Stafford\WK24.xls") ' warning - XLS file could cause problems - see note

For Each SourceWksht In SourceWkb.Worksheets
    If SourceWksht.Visible Then
        SourceWksht.Copy After:=TargetWkb.Sheets(TargetWkb.Sheets.Count)
    End If
Next SourceWksht

TargetWkb.Close True
SourceWkb.Close False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Done = MsgBox("Task Complete", vbOKOnly)

End Sub