Question

我有一个名为“Raw Data”的文件夹，并且有几个excel文件名，扩展名为.xlsx 我有另一个启用宏的Excel文件为“Test.xlsm”。

现在，我有一个宏，以这样的方式工作，它进入本地目录，然后打开excel文件。当我更改文件夹时，这对我来说是不可行的。

是否有可能，我可以有一个代码，它只是查找文件夹“Raw Data”。并打开我提到的文件。

我不知道如何做到这一点。任何领导都会有所帮助。

现在我有以下代码正常工作。（但这会查找来自驱动器位置D“）的原始数据

Private Sub CommandButton11_Click()
Dim filename As String

Workbooks.Open ("D:\Jenny\Raw data\Result.xlsx")

filename = ActiveWorkbook.Path & "\Result.xlsx"

End Sub

Answer 1

假设用户知道文件夹的位置，只需提示输入：

Dim fldr$
Dim fdlg As FileDialog
Set fdlg = Application.FileDialog(msoFileDialogFolderPicker)
fdlg.Show

If fdlg.SelectedItems.Count <> 0 Then
    fldr = fdlg.SelectedItems(1)
Else: 
    Exit Sub
End If

Dim wb as Workbook
Set wb = Workbooks.Open(fldr & Application.PathSeparator & "Results.xlsx")

当然，如果文件不存在于用户选择的文件夹中，您应该进行错误处理等。

或使用Application.FileDialog(msoFileDialogFilePicker)提示用户手动找到文件。应用程序无法知道文件可能存在的位置 - 它们可能只是任何地方，或者它们甚至可能不存在于用户可以访问的位置。

Dim resultsBook as Workbook
Dim testBook as Workbook
Dim fdlg as FileDialog
Set fdlg = Application.FileDialg(msoFileDialogFilePicker)
MsgBOx "Select the Results file"
fdlg.Show
If fdlg.SelectedItems.Count <> 0 Then
    Set resultsBook = Workbooks.Open(fdlg.SelectedItems(1))
Else:
    Exit Sub
End If
MsgBox "Select the Test file"
fdlg.Show
    If fdlg.SelectedItems.Count <> 0 Then
    Set testBook = Workbooks.Open(fdlg.SelectedItems(1))
Else:
    Exit Sub
End If

Answer 2

使用CreateObject("Shell.Application")

的替代方法

Sub tst()

    Dim oShell As Object
    Dim sFolderPath As String

    Set oShell = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0)
    If oShell Is Nothing Then Exit Sub  'Pressed cancel

    sFolderPath = oShell.Self.Path & Application.PathSeparator

    MsgBox sFolderPath
    'Workbooks.Open sFolderPath & "Result.xlsx"

End Sub

Answer 3

听起来您希望能够重命名并可能移动Raw Data文件夹，而不是＆＃34; break＆＃34;宏。如果是这种情况，请将Test.xlsm文件保存在Raw Data文件夹中。

然后执行类似此循环的操作以打开＆amp;处理文件夹中的每个XLSX原始数据文件。我的代码是userFiles / yourrs可能是rawDataFiles或其他东西。

userFilesPath = ThisWorkbook.Path
userFileName = Dir(userFilesPath & "*.xlsx", vbNormal)

Do While userFileName <> ""
    On Error Resume Next
    userFile = userFilesPath & userFileName

    ' this is the raw data file
    On Error Resume Next
    Set uf = Workbooks.Open(Filename:=userFile, UpdateLinks:=False, ReadOnly:=True)

    ' do some stuff with the raw data
    On Error Resume Next
    For Each s In uf.Sheets
        If Len(s.Range("a1").Value) > 1 Then
            s.Range("a1:z" & s.Range("a1000000").End(xlUp).Row).Copy
            ws.Range("a" & ws.Range("a1000000").End(xlUp).Row + 1).PasteSpecial xlPasteValues
        End If
        Application.CutCopyMode = False
    Next
    uf.Close False

    userFileName = Dir
Loop

如何定向到文件夹并访问Excel文件

3 个答案: