Question

只是在工作中做某事，并尝试在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

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

这是一个问题，因为该文件未存储在本地？我正在摸不着头脑。

Answer 1

您在循环中打开工作簿，这意味着它会尝试为每张工作簿打开它 - 并在它已经打开时抛出错误。

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

Sub Test()

    Dim wrkBk As Workbook
    Dim wrkSht As Worksheet

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

    For Each wrkSht In ThisWorkbook.Worksheets
        If wrkSht.Visible Then


            'Copy sheet.
            wrkSht.Copy After:=wrkBk.Sheets(wrkBk.Sheets.Count)
        End If
    Next wrkSht

End Sub

修改：

我对您发布的代码进行了一些更改我删除了If NewFile = False Then Exit Sub - 如果NewFile不是false，它将运行代码，否则它会直接跳到最后。它为您的程序提供了一个退出点我将ActiveWorkbook.Close True更新为您引用的工作簿。 ActiveWorkbook可能并不总是正确的书 - 总是最好避免使用Active或Select ...如果您发现自己使用（或激活或选择或类似），那么您可能会为自己做更多工作。
您的MsgBox不会对任何回复采取行动，它只是通知您，因此无需将其设置为变量。

如果您仍然发现该工作簿无法访问，请仔细检查文件位置，文件名，是否已打开。
哪个文件导致问题？ NewFile还是WK24？

另外 - 你是复制整张纸，单张纸，复印件和复印件吗？ pastespecial - 您不断更改代码。

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

Answer 2

试试这个：

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

我注意到您的“wk24”是XLS文件，但您邀请用户选择要导入的XLS或XLSX个文件。您无法使用此方法将XLSX文件导入XLS文件。我建议您将目标文件更改为WK24.XLSX

Excel无法访问文件

2 个答案: