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

Question

This may be quite a lengthy description, so please bear with me. The problems I am experiencing with Excel are related to custom macros, VBA, and file access.

Background : I am trying to write a macro to process multiple CSV workbooks of data. I have files named RawData_1.csv until RawData_x.csv where x is the number of files I have in a particular folder.

My code for the macro looks like this:

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

Problem 1 (tiny problem) : When I execute the macro, the files somehow "change," and the next time I execute the same macro in the same folder, it will report that the files are not found. The exact error is:

Run-time error '1004':

'RawData_1.csv' could not be found. Check the spelling of the file name, and verify that the file location is correct.

If you are trying to open the file from your list of most recently used files, make sure that the file has now been renamed, moved, or deleted.

I have figured out a solution to this problem. All I have to do is go into the folder with all the csv files, open the FIRST one in the list, and "Save As" as a MS-DOS CSV file. Once I have done this, I can run the macro and it will be able to open ALL the files (not just the first file that I "save as"-ed).

While this is annoying, it's not the worst thing in the world. If there is a reason why excel is doing this, I would love to know! If there is a solution to this problem, even better!

Problem 2 (Big problem) This is the main puzzle that I would like to solve. In the code above, the section that is missing is the part of the code that tells Excel (or the macro) where to find the files. I can do this by hardcoding in the path as follows:

Method 1:

strDir = "C:\whateverPath"

This method ALWAYS works (except when Problem 1 is encountered above).

However, this is clearly not the best way to write the macro, since I will not only be using it once, but will need to use it multiple times, and the data files I wish to import will be in various folders. Therefore, I tried to write it as follows:

Method 2:

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

strDir = folderDialog.SelectedItems(1)

I compared strDir from Method 1 and strDir from Method 2 and found no discernable differences in their values. They both contain the correct path "C:\\whateverPath".

However, using Method 2, excel will be unable to read any of the files in the selected folder. It will return with The same run-time error 1004 as above, and the quick fix I found for Problem 1 above does nothing to help the macro run.

If anyone has any idea what is going on here, I would really appreciate some help figuring this out!

Answer 1

Edit: I think I found the issue. Set wbToCopy = Workbooks.Open(strFileName, , True) , strFileName does not use the fully qualified path. So when you call the .open method, I believe VBA is using the CurDir value and appending it to strFileName . When you perform your "Save As", the CurDir value is changed to the directory you are saving the .csv files in. This gives the illusion that the "Save As" action is what allows your macro to run. In actuality, it is the act of changing the CurDir value to the directory where the files are located. Use a fully qualified file name with .open and it should run everytime.

Previous Suggestion: I don't think your file name is full qualified (your error message should read 'C:\\whateverPath\\RawData_1.csv' could not be found. not 'RawData_1.csv' could not be found. ).

I was having a tough time tracking down the error in the code. This is kind of hacked together but if you get stuck, try using this:

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

Note that this uses the FileSystem library instead of the native Dir function. You also will select the folder name instead of a file name for the dialog box.