Question

这可能是一个很长的描述，所以请耐心等待。我遇到的Excel问题与自定义宏，VBA和文件访问有关。

背景：我正在尝试编写一个宏来处理多个CSV数据工作簿。我有一个名为RawData_1.csv的文件，直到RawData_x.csv，其中x是我在特定文件夹中的文件数。

我的宏代码如下：

Sub ImportData()

    Application.ScreenUpdating = False

    Dim strDir As String
    Dim strFileName As String
    Dim wbToCopy As Workbook
    Dim intCol As Integer

    Set master = ActiveSheet

    **PLEASE SEE BELOW FOR 2 VERSIONS OF CODE THAT CAN GO HERE!**

    strFileName = Dir(strDir & "\*.csv")

    intCol = 2

    Do While Len(strFileName) > 0
        Set wbToCopy = Workbooks.Open(strFileName, , True)

        //Do other things I need it to do here

        wbToCopy.Close (False)

        strFileName = Dir
        intCol = intCol + 2
    Loop

    Application.ScreenUpdating = True

End Sub

问题1（微小问题）：当我执行宏时，文件以某种方式“更改”，并且下次我在同一文件夹中执行相同的宏时，它会报告文件找不到。确切的错误是：

运行时错误'1004'：
     找不到'RawData_1.csv'。检查文件名的拼写，并验证文件位置是否正确。

如果您尝试从最近使用过的文件列表中打开该文件，请确保该文件现已重命名，移动或删除。

我已经找到了解决这个问题的方法。我所要做的就是进入包含所有csv文件的文件夹，打开列表中的第一个文件，然后将“另存为”作为MS-DOS CSV文件。完成后，我可以运行宏，它将能够打开所有文件（而不仅仅是我“保存为”-ed的第一个文件）。

虽然这很烦人，但这并不是世界上最糟糕的事情。如果excel有这样做的原因，我很想知道！如果有解决这个问题的办法，那就更好了！

问题2（大问题） 这是我想要解决的主要难题。在上面的代码中，缺少的部分是代码的一部分，它告诉Excel（或宏）在哪里找到文件。我可以通过硬编码在路径中执行此操作，如下所示：

方法1：

strDir = "C:\whateverPath"

此方法始终有效（除非上面遇到问题1）。

但是，这显然不是编写宏的最佳方法，因为我不仅会使用它一次，而且需要多次使用它，而我想导入的数据文件将放在各种文件夹中。因此，我试着写如下：

方法2：

Dim folderDialog As fileDialog 
Set folderDialog = Application.FileDialog(msoFileDialogeFolderPicker)
folderDialog.AllowMultiSelect = False
folderDialog.Show

strDir = folderDialog.SelectedItems(1)

我比较了方法1中的strDir和方法2中的strDir，发现它们的值没有可辨别的差异。它们都包含正确的路径“C：\ whateverPath”。

但是，使用方法2，excel将无法读取所选文件夹中的任何文件。它将以与上面相同的运行时错误1004返回，并且我在上面的问题1中找到的快速修复无助于宏运行。

如果有人知道这里发生了什么，我真的很感激帮助搞清楚这一点！

Answer 1

编辑：我认为我发现了这个问题。 Set wbToCopy = Workbooks.Open(strFileName, , True)，strFileName不使用完全限定的路径。因此，当您调用.open方法时，我认为VBA正在使用CurDir值并将其附加到strFileName。当您执行“另存为”时，CurDir值将更改为您要保存.csv文件的目录。这会产生错误，即“另存为”操作允许您的宏运行。实际上，它是将CurDir值更改为文件所在目录的行为。使用.open的完全限定文件名，并且每次都应该运行。

以前的建议： 我认为您的文件名不是完全限定的（您的错误消息应该是'C:\whateverPath\RawData_1.csv' could not be found.而不是'RawData_1.csv' could not be found.）。

我很难跟踪代码中的错误。这有点被黑了，但如果你遇到困难，请尝试使用：

Option Explicit
Sub ImportData()

Application.ScreenUpdating = False

Dim strDir As String
Dim strFolderName As String
Dim wbToCopy As Workbook
Dim intCol As Integer
Dim master As Excel.Worksheet

Dim FSO As Object
Dim FSO_FOLDER As Object
Dim FSO_FILE As Object
Dim FILE_EXT As String

FILE_EXT = "csv"
strFolderName = Get_Folder_Path() & "\"

''Create FileSystem Objects
Set FSO = CreateObject("Scripting.FileSystemObject")

Set FSO_FOLDER = FSO.GetFolder(strFolderName)

Set master = ThisWorkbook.ActiveSheet

''**PLEASE SEE BELOW FOR 2 VERSIONS OF CODE THAT CAN GO HERE!**

intCol = 2

If FSO_FOLDER.Files.Count > 0 Then

''Loop through each File in Folder
For Each FSO_FILE In FSO_FOLDER.Files

   ''Test extension
   If FSO.GetExtensionName(FSO_FILE.Name) = FILE_EXT Then

       Set wbToCopy = Workbooks.Open(strFolderName & FSO_FILE.Name, , True)

        ''//Do other things I need it to do here

        wbToCopy.Close (False)
        intCol = intCol + 2

   Else: End If

Next

Else

MsgBox "No Files Found at " & strFolderName

End If

Set FSO = Nothing
Set FSO_FOLDER = Nothing

Application.ScreenUpdating = True

End Sub

Function Get_Folder_Path() As String
Dim folderDialog As FileDialog
Set folderDialog = Application.FileDialog(4)
folderDialog.AllowMultiSelect = False
folderDialog.Show

Get_Folder_Path = folderDialog.SelectedItems(1)

End Function

请注意，这使用FileSystem库而不是本机Dir函数。您还将选择文件夹名称而不是对话框的文件名。

文件夹选择对话框（VBA，Excel 2010）导致文件不可读

1 个答案: